tclwin32dll.c

来自「tcl是工具命令语言」· C语言 代码 · 共 683 行 · 第 1/2 页

	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
# ifdef TCL_MEM_DEBUG
    __asm__ __volatile__ (
            "movl %%esp,  %0" "\n\t"
            "movl %%ebp,  %1" "\n\t"
            "movl %%fs:0, %2" "\n\t"
            : "=m"(INITIAL_ESP),
              "=m"(INITIAL_EBP),
              "=r"(INITIAL_HANDLER) );
# endif /* TCL_MEM_DEBUG */

    __asm__ __volatile__ (
            "pushl %ebp" "\n\t"
            "pushl $__except_checkstackspace_handler" "\n\t"
            "pushl %fs:0" "\n\t"
            "movl  %esp, %fs:0");
#else
    __try {
#endif /* HAVE_NO_SEH */
#ifdef HAVE_ALLOCA_GCC_INLINE
    __asm__ __volatile__ (
            "movl  %0, %%eax" "\n\t"
            "call  __alloca" "\n\t"
            :
            : "i"(TCL_WIN_STACK_THRESHOLD)
            : "%eax");
#else
	alloca(TCL_WIN_STACK_THRESHOLD);
#endif /* HAVE_ALLOCA_GCC_INLINE */
	retval = 1;
#ifdef HAVE_NO_SEH
    __asm__ __volatile__ (
            "movl %%fs:0, %%esp" "\n\t"
            "jmp  checkstackspace_pop" "\n"
        "checkstackspace_reentry:" "\n\t"
            "movl %%fs:0, %%eax" "\n\t"
            "movl 0x8(%%eax), %%esp" "\n\t"
            "movl 0x8(%%esp), %%ebp" "\n"
        "checkstackspace_pop:" "\n\t"
            "movl (%%esp), %%eax" "\n\t"
            "movl %%eax, %%fs:0" "\n\t"
            "add  $12, %%esp" "\n\t"
            :
            :
            : "%eax");

# ifdef TCL_MEM_DEBUG
    __asm__ __volatile__ (
            "movl  %%esp,  %0" "\n\t"
            "movl  %%ebp,  %1" "\n\t"
            "movl  %%fs:0, %2" "\n\t"
            : "=m"(RESTORED_ESP),
              "=m"(RESTORED_EBP),
              "=r"(RESTORED_HANDLER) );

    if (INITIAL_ESP != RESTORED_ESP)
        panic("ESP restored incorrectly");
    if (INITIAL_EBP != RESTORED_EBP)
        panic("EBP restored incorrectly");
    if (INITIAL_HANDLER != RESTORED_HANDLER)
        panic("HANDLER restored incorrectly");
# endif /* TCL_MEM_DEBUG */
#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");
    /* Nuke compiler warning about unused static function */
    _except_checkstackspace_handler(NULL, NULL, NULL, NULL);
    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);
	    }
	}
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * TclWinResetInterfaceEncodings --
 *
 *	Called during finalization to free up any encodings we use.
 *	The tclWinProcs-> look up table is still ok to use after
 *	this call, provided no encoding conversion is required.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */
void
TclWinResetInterfaceEncodings()
{
    if (tclWinTCharEncoding != NULL) {
	Tcl_FreeEncoding(tclWinTCharEncoding);
	tclWinTCharEncoding = NULL;
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * TclWinResetInterfaces --
 *
 *	Called during finalization to reset us to a safe state for reuse.
 *	After this call, it is best not to use the tclWinProcs-> look
 *	up table since it is likely to be different to what is expected.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */
void
TclWinResetInterfaces()
{
    tclWinProcs = &asciiProcs;
}

/*
 *---------------------------------------------------------------------------
 *
 * 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);
}