/* * 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: @(#) tclWin32Dll.c,v 1.9 2003/01/21 19:40:22 hunt Exp */ #include "tclWinInt.h" /* * 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 static void *ESP; static void *EBP; #endif /* HAVE_NO_SEH */ /* * 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 /* *---------------------------------------------------------------------- * * 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); } /* *---------------------------------------------------------------------- * * 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__ */ /* *---------------------------------------------------------------------- * * TclWinGetTclInstance -- * * Retrieves the global library instance handle. * * Results: * Returns the global library instance handle. * * Side effects: * None. * *---------------------------------------------------------------------- */ HINSTANCE TclWinGetTclInstance() { return hInstance; } /* *---------------------------------------------------------------------- * * 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"); } tclWinProcs = &asciiProcs; } /* *---------------------------------------------------------------------- * * 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; } /* *------------------------------------------------------------------------- * * 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; } /* *---------------------------------------------------------------------- * * 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() { 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__ ( "movl %esp, _ESP" "\n\t" "movl %ebp, _EBP"); __asm__ __volatile__ ( "pushl $__except_checkstackspace_handler" "\n\t" "pushl %fs:0" "\n\t" "mov %esp, %fs:0"); #else __try { #endif /* HAVE_NO_SEH */ alloca(TCL_WIN_STACK_THRESHOLD); retval = 1; #ifdef HAVE_NO_SEH __asm__ __volatile__ ( "jmp checkstackspace_pop" "\n" "checkstackspace_reentry:" "\n\t" "movl _ESP, %esp" "\n\t" "movl _EBP, %ebp"); __asm__ __volatile__ ( "checkstackspace_pop:" "\n\t" "mov (%esp), %eax" "\n\t" "mov %eax, %fs:0" "\n\t" "add $8, %esp"); #else } __except (EXCEPTION_EXECUTE_HANDLER) {} #endif /* HAVE_NO_SEH */ /* * Avoid using control flow statements in the SEH guarded block! */ return retval; } #ifdef HAVE_NO_SEH static __attribute__ ((cdecl)) EXCEPTION_DISPOSITION _except_checkstackspace_handler( struct _EXCEPTION_RECORD *ExceptionRecord, void *EstablisherFrame, struct _CONTEXT *ContextRecord, void *DispatcherContext) { __asm__ __volatile__ ( "jmp checkstackspace_reentry"); return 0; /* Function does not return */ } #endif /* HAVE_NO_SEH */ /* *---------------------------------------------------------------------- * * 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; } /* *--------------------------------------------------------------------------- * * 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); } } } } /* *--------------------------------------------------------------------------- * * 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); }