* generic/tcl.decls: [TIP #357]: First round of changes

* generic/tclDecls.h:		to export Tcl_LoadFile, Tcl_FindSymbol,
* generic/tclIOUtil.c:		and Tcl_FSUnloadFile to the public API.
* generic/tclInt.h:
* generic/tclLoad.c:
* generic/tclLoadNone.c:
* generic/tclStubInit.c:
* tests/fileSystem.test:
* tests/load.test:
* tests/unload.test:
* unix/tclLoadDl.c:
* unix/tclLoadDyld.c:
* unix/tclLoadNext.c:
* unix/tclLoadOSF.c:
* unix/tclLoadShl.c:
* unix/tclUnixPipe.c:
* win/Makefile.in:
* win/tclWinLoad.c:

2 files changed, 147 insertions, 25 deletions

diff --git a/win/Makefile.in b/win/Makefile.in
index 5c6e085..0a5956a 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -4,7 +4,7 @@
 # "./configure", which is a configuration script generated by the "autoconf"
 # program (constructs like "@foo@" will get replaced in the actual Makefile.
 #
-# RCS: @(#) $Id: Makefile.in,v 1.174 2010/03/30 14:05:53 dgp Exp $
+# RCS: @(#) $Id: Makefile.in,v 1.175 2010/04/02 21:21:06 kennykb Exp $
 
 VERSION = @TCL_VERSION@
 
@@ -585,7 +585,7 @@ install-binaries: binaries
 		else true; \
 		fi; \
 	    done;
-	@for i in dde1.3 reg1.2; \
+	@for i in dde${DDEDOTVER} reg${REGDOTVER}; \
 	    do \
 	    if [ ! -d $(LIB_INSTALL_DIR)/$$i ] ; then \
 		echo "Making directory $(LIB_INSTALL_DIR)/$$i"; \
diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c
index bdc62ae..606171d 100644
--- a/win/tclWinLoad.c
+++ b/win/tclWinLoad.c
@@ -10,11 +10,30 @@
  * 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.26 2010/03/11 15:02:33 nijtmans Exp $
+ * RCS: @(#) $Id: tclWinLoad.c,v 1.27 2010/04/02 21:21:06 kennykb Exp $
  */
 
 #include "tclWinInt.h"
 
+/*
+ * Mutex protecting static data in this file;
+ */
+
+static Tcl_Mutex loadMutex;
+
+/*
+ * Name of the directory in the native filesystem where DLLs used in this
+ * process are copied prior to loading.
+ */
+
+static WCHAR* dllDirectoryName = NULL;
+
+/* Static functions defined within this file */
+
+void* FindSymbol(Tcl_Interp* interp, Tcl_LoadHandle loadHandle,
+		 const char* symbol);
+void UnloadFile(Tcl_LoadHandle loadHandle);
+
 
 /*
  *----------------------------------------------------------------------
@@ -47,8 +66,9 @@ TclpDlopen(
 				 * function which should be used for this
 				 * file. */
 {
-    HINSTANCE handle;
+    HINSTANCE hInstance;
     const TCHAR *nativeName;
+    Tcl_LoadHandle handlePtr;
 
     /*
      * First try the full path the user gave us. This is particularly
@@ -57,8 +77,8 @@ TclpDlopen(
      */
 
     nativeName = Tcl_FSGetNativePath(pathPtr);
-    handle = tclWinProcs->loadLibraryProc(nativeName);
-    if (handle == NULL) {
+    hInstance = tclWinProcs->loadLibraryProc(nativeName);
+    if (hInstance == 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
@@ -69,13 +89,11 @@ TclpDlopen(
 	const char *fileName = Tcl_GetString(pathPtr);
 
 	nativeName = tclWinProcs->utf2tchar(fileName, -1, &ds);
-	handle = tclWinProcs->loadLibraryProc(nativeName);
+	hInstance = tclWinProcs->loadLibraryProc(nativeName);
 	Tcl_DStringFree(&ds);
     }
 
-    *loadHandle = (Tcl_LoadHandle) handle;
-
-    if (handle == NULL) {
+    if (hInstance == NULL) {
 	DWORD lastError = GetLastError();
 
 #if 0
@@ -130,7 +148,13 @@ TclpDlopen(
 	}
 	return TCL_ERROR;
     } else {
-	*unloadProcPtr = &TclpUnloadFile;
+	handlePtr = 
+	    (Tcl_LoadHandle) ckalloc(sizeof(struct Tcl_LoadHandle_));
+	handlePtr->clientData = (ClientData) hInstance;
+	handlePtr->findSymbolProcPtr = &FindSymbol;
+	handlePtr->unloadFileProcPtr = &UnloadFile;
+	*loadHandle = (Tcl_LoadHandle) handlePtr;
+	*unloadProcPtr = &UnloadFile;
     }
     return TCL_OK;
 }
@@ -138,7 +162,7 @@ TclpDlopen(
 /*
  *----------------------------------------------------------------------
  *
- * TclpFindSymbol --
+ * FindSymbol --
  *
  *	Looks up a symbol, by name, through a handle associated with a
  *	previously loaded piece of code (shared library).
@@ -151,37 +175,41 @@ TclpDlopen(
  *----------------------------------------------------------------------
  */
 
-Tcl_PackageInitProc *
-TclpFindSymbol(
+void *
+FindSymbol(
     Tcl_Interp *interp,
     Tcl_LoadHandle loadHandle,
     const char *symbol)
 {
     Tcl_PackageInitProc *proc = NULL;
-    HINSTANCE handle = (HINSTANCE)loadHandle;
+    HINSTANCE hInstance = (HINSTANCE)(loadHandle->clientData);
 
     /*
      * For each symbol, check for both Symbol and _Symbol, since Borland
      * generates C symbols with a leading '_' by default.
      */
 
-    proc = (Tcl_PackageInitProc *) GetProcAddress(handle, symbol);
+    proc = (void*) GetProcAddress(hInstance, symbol);
     if (proc == NULL) {
 	Tcl_DString ds;
-
+	const char* sym2;
 	Tcl_DStringInit(&ds);
 	Tcl_DStringAppend(&ds, "_", 1);
-	symbol = Tcl_DStringAppend(&ds, symbol, -1);
-	proc = (Tcl_PackageInitProc *) GetProcAddress(handle, symbol);
+	sym2 = Tcl_DStringAppend(&ds, symbol, -1);
+	proc = (Tcl_PackageInitProc *) GetProcAddress(hInstance, sym2);
 	Tcl_DStringFree(&ds);
     }
+    if (proc == NULL && interp != NULL) {
+	Tcl_AppendResult(interp, "cannot find symbol \"", symbol, "\"", NULL);
+	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, NULL);
+    }
     return proc;
 }
 
 /*
  *----------------------------------------------------------------------
  *
- * TclpUnloadFile --
+ * UnloadFile --
  *
  *	Unloads a dynamically loaded binary code file from memory. Code
  *	pointers in the formerly loaded file are no longer valid after calling
@@ -197,15 +225,14 @@ TclpFindSymbol(
  */
 
 void
-TclpUnloadFile(
+UnloadFile(
     Tcl_LoadHandle loadHandle)	/* loadHandle returned by a previous call to
 				 * TclpDlopen(). The loadHandle is a token
 				 * that represents the loaded file. */
 {
-    HINSTANCE handle;
-
-    handle = (HINSTANCE) loadHandle;
-    FreeLibrary(handle);
+    HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData;
+    FreeLibrary(hInstance);
+    ckfree((char*) loadHandle);
 }
 
 /*
@@ -239,6 +266,101 @@ TclGuessPackageName(
 }
 
 /*
+ *-----------------------------------------------------------------------------
+ *
+ * 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 */
+{
+    size_t nameLen;		/* Length of the temp folder name */
+    WCHAR name[MAX_PATH];	/* Path name of the temp folder */
+    BOOL status;		/* Status from Win32 API calls */
+    Tcl_Obj* fileName;		/* Name of the temp file */
+    Tcl_Obj* tail;		/* Tail of the source path */
+
+    /*
+     * 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 = 0;
+    if (dllDirectoryName == NULL) {
+	Tcl_MutexLock(&loadMutex);
+	if (dllDirectoryName == NULL) {
+	    if ((nameLen = GetTempPathW(MAX_PATH, name)) >= 0) {
+		if (nameLen >= MAX_PATH-12) {
+		    Tcl_SetErrno(ENAMETOOLONG);
+		    nameLen = 0;
+		} else {
+		    wcscpy(name+nameLen, L"TCLXXXXXXXX");
+		    nameLen += 11;
+		}
+	    }
+	    status = 1;
+	    if (nameLen != 0) {
+		DWORD id;
+		int i = 0;
+		id = GetCurrentProcessId();
+		for (;;) {
+		    DWORD lastError;
+		    wsprintfW(name+nameLen-8, L"%08x", id);
+		    status = CreateDirectoryW(name, NULL);
+		    if (status) {
+			break;
+		    }
+		    if ((lastError = GetLastError()) != ERROR_ALREADY_EXISTS) {
+			TclWinConvertError(lastError);
+			break;
+		    } else if (++i > 256) {
+			TclWinConvertError(lastError);
+			break;
+		    }
+		    id *= 16777619;
+		}
+	    }
+	    if (status != 0) {
+		dllDirectoryName = (WCHAR*)
+		    ckalloc((nameLen+1) * sizeof(WCHAR));
+		wcscpy(dllDirectoryName, name);
+	    }
+	}
+	Tcl_MutexUnlock(&loadMutex);
+    }
+    if (dllDirectoryName == NULL) {
+	Tcl_AppendResult(interp, "couldn't create temporary directory: ",
+			 Tcl_PosixError(interp), NULL);
+    }
+    fileName = TclpNativeToNormalized((ClientData) dllDirectoryName);
+    tail = TclPathPart(interp, path, TCL_PATH_TAIL);
+    if (tail == NULL) {
+	Tcl_DecrRefCount(fileName);
+	return NULL;
+    } else {
+	Tcl_AppendToObj(fileName, "/", 1);
+	Tcl_AppendObjToObj(fileName, tail);
+	return fileName;
+    }    
+}
+
+/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4