--- /dev/null
+/*
+ * tclWin32Dll.c --
+ *
+ * This file contains the DLL entry point.
+ *
+ * Copyright (c) 1995-1996 Sun Microsystems, Inc.
+ * Copyright (c) 1998-2000 Scriptics Corporation.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tclWinInt.h"
+#ifdef __CYGWIN__
+#include <sys/cygwin.h>
+#endif
+
+/*
+ * The following data structures are used when loading the thunking
+ * library for execing child processes under Win32s.
+ */
+
+typedef DWORD (WINAPI UT32PROC)(LPVOID lpBuff, DWORD dwUserDefined,
+ LPVOID *lpTranslationList);
+
+typedef BOOL (WINAPI UTREGISTER)(HANDLE hModule, LPCSTR SixteenBitDLL,
+ LPCSTR InitName, LPCSTR ProcName, UT32PROC **ThirtyTwoBitThunk,
+ FARPROC UT32Callback, LPVOID Buff);
+
+typedef VOID (WINAPI UTUNREGISTER)(HANDLE hModule);
+
+/*
+ * The following variables keep track of information about this DLL
+ * on a per-instance basis. Each time this DLL is loaded, it gets its own
+ * new data segment with its own copy of all static and global information.
+ */
+
+static HINSTANCE hInstance; /* HINSTANCE of this DLL. */
+static int platformId; /* Running under NT, or 95/98? */
+
+#ifdef HAVE_NO_SEH
+/*
+ * Unlike Borland and Microsoft, we don't register exception handlers by
+ * pushing registration records onto the runtime stack. Instead, we register
+ * them by creating an EXCEPTION_REGISTRATION within the activation record.
+ */
+
+typedef struct EXCEPTION_REGISTRATION {
+ struct EXCEPTION_REGISTRATION *link;
+ EXCEPTION_DISPOSITION (*handler)(
+ struct _EXCEPTION_RECORD*, void*, struct _CONTEXT*, void*);
+ void *ebp;
+ void *esp;
+ int status;
+} EXCEPTION_REGISTRATION;
+#endif
+
+/*
+ * The following function tables are used to dispatch to either the
+ * wide-character or multi-byte versions of the operating system calls,
+ * depending on whether the Unicode calls are available.
+ */
+
+static TclWinProcs asciiProcs = {
+ 0,
+
+ (BOOL (WINAPI *)(CONST TCHAR *, LPDCB)) BuildCommDCBA,
+ (TCHAR *(WINAPI *)(TCHAR *)) CharLowerA,
+ (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *, BOOL)) CopyFileA,
+ (BOOL (WINAPI *)(CONST TCHAR *, LPSECURITY_ATTRIBUTES)) CreateDirectoryA,
+ (HANDLE (WINAPI *)(CONST TCHAR *, DWORD, DWORD, SECURITY_ATTRIBUTES *,
+ DWORD, DWORD, HANDLE)) CreateFileA,
+ (BOOL (WINAPI *)(CONST TCHAR *, TCHAR *, LPSECURITY_ATTRIBUTES,
+ LPSECURITY_ATTRIBUTES, BOOL, DWORD, LPVOID, CONST TCHAR *,
+ LPSTARTUPINFOA, LPPROCESS_INFORMATION)) CreateProcessA,
+ (BOOL (WINAPI *)(CONST TCHAR *)) DeleteFileA,
+ (HANDLE (WINAPI *)(CONST TCHAR *, WIN32_FIND_DATAT *)) FindFirstFileA,
+ (BOOL (WINAPI *)(HANDLE, WIN32_FIND_DATAT *)) FindNextFileA,
+ (BOOL (WINAPI *)(WCHAR *, LPDWORD)) GetComputerNameA,
+ (DWORD (WINAPI *)(DWORD, WCHAR *)) GetCurrentDirectoryA,
+ (DWORD (WINAPI *)(CONST TCHAR *)) GetFileAttributesA,
+ (DWORD (WINAPI *)(CONST TCHAR *, DWORD nBufferLength, WCHAR *,
+ TCHAR **)) GetFullPathNameA,
+ (DWORD (WINAPI *)(HMODULE, WCHAR *, int)) GetModuleFileNameA,
+ (DWORD (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD)) GetShortPathNameA,
+ (UINT (WINAPI *)(CONST TCHAR *, CONST TCHAR *, UINT uUnique,
+ WCHAR *)) GetTempFileNameA,
+ (DWORD (WINAPI *)(DWORD, WCHAR *)) GetTempPathA,
+ (BOOL (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD, LPDWORD, LPDWORD, LPDWORD,
+ WCHAR *, DWORD)) GetVolumeInformationA,
+ (HINSTANCE (WINAPI *)(CONST TCHAR *)) LoadLibraryA,
+ (TCHAR (WINAPI *)(WCHAR *, CONST TCHAR *)) lstrcpyA,
+ (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *)) MoveFileA,
+ (BOOL (WINAPI *)(CONST TCHAR *)) RemoveDirectoryA,
+ (DWORD (WINAPI *)(CONST TCHAR *, CONST TCHAR *, CONST TCHAR *, DWORD,
+ WCHAR *, TCHAR **)) SearchPathA,
+ (BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryA,
+ (BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesA,
+ NULL,
+ NULL,
+};
+
+static TclWinProcs unicodeProcs = {
+ 1,
+
+ (BOOL (WINAPI *)(CONST TCHAR *, LPDCB)) BuildCommDCBW,
+ (TCHAR *(WINAPI *)(TCHAR *)) CharLowerW,
+ (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *, BOOL)) CopyFileW,
+ (BOOL (WINAPI *)(CONST TCHAR *, LPSECURITY_ATTRIBUTES)) CreateDirectoryW,
+ (HANDLE (WINAPI *)(CONST TCHAR *, DWORD, DWORD, SECURITY_ATTRIBUTES *,
+ DWORD, DWORD, HANDLE)) CreateFileW,
+ (BOOL (WINAPI *)(CONST TCHAR *, TCHAR *, LPSECURITY_ATTRIBUTES,
+ LPSECURITY_ATTRIBUTES, BOOL, DWORD, LPVOID, CONST TCHAR *,
+ LPSTARTUPINFOA, LPPROCESS_INFORMATION)) CreateProcessW,
+ (BOOL (WINAPI *)(CONST TCHAR *)) DeleteFileW,
+ (HANDLE (WINAPI *)(CONST TCHAR *, WIN32_FIND_DATAT *)) FindFirstFileW,
+ (BOOL (WINAPI *)(HANDLE, WIN32_FIND_DATAT *)) FindNextFileW,
+ (BOOL (WINAPI *)(WCHAR *, LPDWORD)) GetComputerNameW,
+ (DWORD (WINAPI *)(DWORD, WCHAR *)) GetCurrentDirectoryW,
+ (DWORD (WINAPI *)(CONST TCHAR *)) GetFileAttributesW,
+ (DWORD (WINAPI *)(CONST TCHAR *, DWORD nBufferLength, WCHAR *,
+ TCHAR **)) GetFullPathNameW,
+ (DWORD (WINAPI *)(HMODULE, WCHAR *, int)) GetModuleFileNameW,
+ (DWORD (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD)) GetShortPathNameW,
+ (UINT (WINAPI *)(CONST TCHAR *, CONST TCHAR *, UINT uUnique,
+ WCHAR *)) GetTempFileNameW,
+ (DWORD (WINAPI *)(DWORD, WCHAR *)) GetTempPathW,
+ (BOOL (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD, LPDWORD, LPDWORD, LPDWORD,
+ WCHAR *, DWORD)) GetVolumeInformationW,
+ (HINSTANCE (WINAPI *)(CONST TCHAR *)) LoadLibraryW,
+ (TCHAR (WINAPI *)(WCHAR *, CONST TCHAR *)) lstrcpyW,
+ (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *)) MoveFileW,
+ (BOOL (WINAPI *)(CONST TCHAR *)) RemoveDirectoryW,
+ (DWORD (WINAPI *)(CONST TCHAR *, CONST TCHAR *, CONST TCHAR *, DWORD,
+ WCHAR *, TCHAR **)) SearchPathW,
+ (BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryW,
+ (BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesW,
+ NULL,
+ NULL,
+};
+
+TclWinProcs *tclWinProcs;
+static Tcl_Encoding tclWinTCharEncoding;
+
+/*
+ * The following declaration is for the VC++ DLL entry point.
+ */
+
+BOOL APIENTRY DllMain(HINSTANCE hInst, DWORD reason,
+ LPVOID reserved);
+
+
+#ifdef __WIN32__
+#ifndef STATIC_BUILD
+
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * DllEntryPoint --
+ *
+ * This wrapper function is used by Borland to invoke the
+ * initialization code for Tcl. It simply calls the DllMain
+ * routine.
+ *
+ * Results:
+ * See DllMain.
+ *
+ * Side effects:
+ * See DllMain.
+ *
+ *----------------------------------------------------------------------
+ */
+
+BOOL APIENTRY
+DllEntryPoint(hInst, reason, reserved)
+ HINSTANCE hInst; /* Library instance handle. */
+ DWORD reason; /* Reason this function is being called. */
+ LPVOID reserved; /* Not used. */
+{
+ return DllMain(hInst, reason, reserved);
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * DllMain --
+ *
+ * This routine is called by the VC++ C run time library init
+ * code, or the DllEntryPoint routine. It is responsible for
+ * initializing various dynamically loaded libraries.
+ *
+ * Results:
+ * TRUE on sucess, FALSE on failure.
+ *
+ * Side effects:
+ * Establishes 32-to-16 bit thunk and initializes sockets library.
+ *
+ *----------------------------------------------------------------------
+ */
+BOOL APIENTRY
+DllMain(hInst, reason, reserved)
+ HINSTANCE hInst; /* Library instance handle. */
+ DWORD reason; /* Reason this function is being called. */
+ LPVOID reserved; /* Not used. */
+{
+ switch (reason) {
+ case DLL_PROCESS_ATTACH:
+ TclWinInit(hInst);
+ return TRUE;
+
+ case DLL_PROCESS_DETACH:
+ if (hInst == hInstance) {
+ Tcl_Finalize();
+ }
+ break;
+ }
+
+ return TRUE;
+}
+
+#endif /* !STATIC_BUILD */
+#endif /* __WIN32__ */
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclWinGetTclInstance --
+ *
+ * Retrieves the global library instance handle.
+ *
+ * Results:
+ * Returns the global library instance handle.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+HINSTANCE
+TclWinGetTclInstance()
+{
+ return hInstance;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclWinInit --
+ *
+ * This function initializes the internal state of the tcl library.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Initializes the tclPlatformId variable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclWinInit(hInst)
+ HINSTANCE hInst; /* Library instance handle. */
+{
+ OSVERSIONINFO os;
+
+ hInstance = hInst;
+ os.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
+ GetVersionEx(&os);
+ platformId = os.dwPlatformId;
+
+ /*
+ * We no longer support Win32s, so just in case someone manages to
+ * get a runtime there, make sure they know that.
+ */
+
+ if (platformId == VER_PLATFORM_WIN32s) {
+ panic("Win32s is not a supported platform");
+ }
+
+#ifdef __CYGWIN__
+ {
+ char cwd_posix[MAX_PATH], cwd_win32[MAX_PATH];
+ cygwin_conv_to_full_win32_path (getcwd (cwd_posix, MAX_PATH), cwd_win32);
+ SetCurrentDirectory (cwd_win32);
+ }
+#endif
+
+ tclWinProcs = &asciiProcs;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclWinGetPlatformId --
+ *
+ * Determines whether running under NT, 95, or Win32s, to allow
+ * runtime conditional code.
+ *
+ * Results:
+ * The return value is one of:
+ * VER_PLATFORM_WIN32s Win32s on Windows 3.1. (not supported)
+ * VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 95.
+ * VER_PLATFORM_WIN32_NT Win32 on Windows NT
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclWinGetPlatformId()
+{
+ return platformId;
+}
+\f
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TclWinNoBackslash --
+ *
+ * We're always iterating through a string in Windows, changing the
+ * backslashes to slashes for use in Tcl.
+ *
+ * Results:
+ * All backslashes in given string are changed to slashes.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+char *
+TclWinNoBackslash(
+ char *path) /* String to change. */
+{
+ char *p;
+
+ for (p = path; *p != '\0'; p++) {
+ if (*p == '\\') {
+ *p = '/';
+ }
+ }
+ return path;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpCheckStackSpace --
+ *
+ * Detect if we are about to blow the stack. Called before an
+ * evaluation can happen when nesting depth is checked.
+ *
+ * Results:
+ * 1 if there is enough stack space to continue; 0 if not.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclpCheckStackSpace()
+{
+
+#ifdef HAVE_NO_SEH
+ EXCEPTION_REGISTRATION registration;
+#endif
+ int retval = 0;
+
+ /*
+ * We can recurse only if there is at least TCL_WIN_STACK_THRESHOLD bytes
+ * of stack space left. alloca() is cheap on windows; basically it just
+ * subtracts from the stack pointer causing the OS to throw an exception
+ * if the stack pointer is set below the bottom of the stack.
+ */
+
+#ifdef HAVE_NO_SEH
+ __asm__ __volatile__ (
+
+ /*
+ * Construct an EXCEPTION_REGISTRATION to protect the call to __alloca
+ */
+
+ "leal %[registration], %%edx" "\n\t"
+ "movl %%fs:0, %%eax" "\n\t"
+ "movl %%eax, 0x0(%%edx)" "\n\t" /* link */
+ "leal 1f, %%eax" "\n\t"
+ "movl %%eax, 0x4(%%edx)" "\n\t" /* handler */
+ "movl %%ebp, 0x8(%%edx)" "\n\t" /* ebp */
+ "movl %%esp, 0xc(%%edx)" "\n\t" /* esp */
+ "movl %[error], 0x10(%%edx)" "\n\t" /* status */
+
+ /*
+ * Link the EXCEPTION_REGISTRATION on the chain
+ */
+
+ "movl %%edx, %%fs:0" "\n\t"
+
+ /*
+ * Attempt a call to __alloca, to determine whether there's sufficient
+ * memory to be had.
+ */
+
+ "movl %[size], %%eax" "\n\t"
+ "pushl %%eax" "\n\t"
+ "call __alloca" "\n\t"
+
+ /*
+ * Come here on a normal exit. Recover the EXCEPTION_REGISTRATION and
+ * store a TCL_OK status
+ */
+
+ "movl %%fs:0, %%edx" "\n\t"
+ "movl %[ok], %%eax" "\n\t"
+ "movl %%eax, 0x10(%%edx)" "\n\t"
+ "jmp 2f" "\n"
+
+ /*
+ * Come here on an exception. Get the EXCEPTION_REGISTRATION that we
+ * previously put on the chain.
+ */
+
+ "1:" "\t"
+ "movl %%fs:0, %%edx" "\n\t"
+ "movl 0x8(%%edx), %%edx" "\n\t"
+
+ /*
+ * Come here however we exited. Restore context from the
+ * EXCEPTION_REGISTRATION in case the stack is unbalanced.
+ */
+
+ "2:" "\t"
+ "movl 0xc(%%edx), %%esp" "\n\t"
+ "movl 0x8(%%edx), %%ebp" "\n\t"
+ "movl 0x0(%%edx), %%eax" "\n\t"
+ "movl %%eax, %%fs:0" "\n\t"
+
+ :
+ /* No outputs */
+ :
+ [registration] "m" (registration),
+ [ok] "i" (TCL_OK),
+ [error] "i" (TCL_ERROR),
+ [size] "i" (TCL_WIN_STACK_THRESHOLD)
+ :
+ "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory"
+ );
+ retval = (registration.status == TCL_OK);
+
+#else /* !HAVE_NO_SEH */
+ __try {
+ alloca(TCL_WIN_STACK_THRESHOLD);
+ retval = 1;
+ } __except (EXCEPTION_EXECUTE_HANDLER) {}
+#endif /* HAVE_NO_SEH */
+
+ return retval;
+}
+
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclWinGetPlatform --
+ *
+ * This is a kludge that allows the test library to get access
+ * the internal tclPlatform variable.
+ *
+ * Results:
+ * Returns a pointer to the tclPlatform variable.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TclPlatformType *
+TclWinGetPlatform()
+{
+ return &tclPlatform;
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclWinSetInterfaces --
+ *
+ * A helper proc that allows the test library to change the
+ * tclWinProcs structure to dispatch to either the wide-character
+ * or multi-byte versions of the operating system calls, depending
+ * on whether Unicode is the system encoding.
+ *
+ * As well as this, we can also try to load in some additional
+ * procs which may/may not be present depending on the current
+ * Windows version (e.g. Win95 will not have the procs below).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TclWinSetInterfaces(
+ int wide) /* Non-zero to use wide interfaces, 0
+ * otherwise. */
+{
+ Tcl_FreeEncoding(tclWinTCharEncoding);
+
+ if (wide) {
+ tclWinProcs = &unicodeProcs;
+ tclWinTCharEncoding = Tcl_GetEncoding(NULL, "unicode");
+ if (tclWinProcs->getFileAttributesExProc == NULL) {
+ HINSTANCE hInstance = LoadLibraryA("kernel32");
+ if (hInstance != NULL) {
+ tclWinProcs->getFileAttributesExProc =
+ (BOOL (WINAPI *)(CONST TCHAR *, GET_FILEEX_INFO_LEVELS,
+ LPVOID)) GetProcAddress(hInstance, "GetFileAttributesExW");
+ tclWinProcs->createHardLinkProc =
+ (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR*,
+ LPSECURITY_ATTRIBUTES)) GetProcAddress(hInstance,
+ "CreateHardLinkW");
+ FreeLibrary(hInstance);
+ }
+ }
+ } else {
+ tclWinProcs = &asciiProcs;
+ tclWinTCharEncoding = NULL;
+ if (tclWinProcs->getFileAttributesExProc == NULL) {
+ HINSTANCE hInstance = LoadLibraryA("kernel32");
+ if (hInstance != NULL) {
+ tclWinProcs->getFileAttributesExProc =
+ (BOOL (WINAPI *)(CONST TCHAR *, GET_FILEEX_INFO_LEVELS,
+ LPVOID)) GetProcAddress(hInstance, "GetFileAttributesExA");
+ tclWinProcs->createHardLinkProc =
+ (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR*,
+ LPSECURITY_ATTRIBUTES)) GetProcAddress(hInstance,
+ "CreateHardLinkA");
+ FreeLibrary(hInstance);
+ }
+ }
+ }
+}
+\f
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tcl_WinUtfToTChar, Tcl_WinTCharToUtf --
+ *
+ * Convert between UTF-8 and Unicode when running Windows NT or
+ * the current ANSI code page when running Windows 95.
+ *
+ * On Mac, Unix, and Windows 95, all strings exchanged between Tcl
+ * and the OS are "char" oriented. We need only one Tcl_Encoding to
+ * convert between UTF-8 and the system's native encoding. We use
+ * NULL to represent that encoding.
+ *
+ * On NT, some strings exchanged between Tcl and the OS are "char"
+ * oriented, while others are in Unicode. We need two Tcl_Encoding
+ * APIs depending on whether we are targeting a "char" or Unicode
+ * interface.
+ *
+ * Calling Tcl_UtfToExternal() or Tcl_ExternalToUtf() with an
+ * encoding of NULL should always used to convert between UTF-8
+ * and the system's "char" oriented encoding. The following two
+ * functions are used in Windows-specific code to convert between
+ * UTF-8 and Unicode strings (NT) or "char" strings(95). This saves
+ * you the trouble of writing the following type of fragment over and
+ * over:
+ *
+ * if (running NT) {
+ * encoding <- Tcl_GetEncoding("unicode");
+ * nativeBuffer <- UtfToExternal(encoding, utfBuffer);
+ * Tcl_FreeEncoding(encoding);
+ * } else {
+ * nativeBuffer <- UtfToExternal(NULL, utfBuffer);
+ * }
+ *
+ * By convention, in Windows a TCHAR is a character in the ANSI code
+ * page on Windows 95, a Unicode character on Windows NT. If you
+ * plan on targeting a Unicode interfaces when running on NT and a
+ * "char" oriented interface while running on 95, these functions
+ * should be used. If you plan on targetting the same "char"
+ * oriented function on both 95 and NT, use Tcl_UtfToExternal()
+ * with an encoding of NULL.
+ *
+ * Results:
+ * The result is a pointer to the string in the desired target
+ * encoding. Storage for the result string is allocated in
+ * dsPtr; the caller must call Tcl_DStringFree() when the result
+ * is no longer needed.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+TCHAR *
+Tcl_WinUtfToTChar(string, len, dsPtr)
+ CONST char *string; /* Source string in UTF-8. */
+ int len; /* Source string length in bytes, or < 0 for
+ * strlen(). */
+ Tcl_DString *dsPtr; /* Uninitialized or free DString in which
+ * the converted string is stored. */
+{
+ return (TCHAR *) Tcl_UtfToExternalDString(tclWinTCharEncoding,
+ string, len, dsPtr);
+}
+
+char *
+Tcl_WinTCharToUtf(string, len, dsPtr)
+ CONST TCHAR *string; /* Source string in Unicode when running
+ * NT, ANSI when running 95. */
+ int len; /* Source string length in bytes, or < 0 for
+ * platform-specific string length. */
+ Tcl_DString *dsPtr; /* Uninitialized or free DString in which
+ * the converted string is stored. */
+{
+ return Tcl_ExternalToUtfDString(tclWinTCharEncoding,
+ (CONST char *) string, len, dsPtr);
+}