shared_source/c_tcl_base_7_5_w_mods/tclwin32dll.c

/* $Header$ */
/* 
 * 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: tclwin32dll.c,v 1.1.1.1 2001/06/13 04:48:12 dtashley 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? */

/*
 * 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,
};

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,
};

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()
{
    /*
     * 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.
     */

    __try {
        alloca(TCL_WIN_STACK_THRESHOLD);
        return 1;
    } __except (1) {}

    return 0;
}


/*
 *----------------------------------------------------------------------
 *
 * 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.
 *
 * 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");
    } else {
        tclWinProcs = &asciiProcs;
        tclWinTCharEncoding = NULL;
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * 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);
}

/* End of tclwin32dll.c */
1	/* $Header$ */
2	/*
3	* tclWin32Dll.c --
4	*
5	* This file contains the DLL entry point.
6	*
7	* Copyright (c) 1995-1996 Sun Microsystems, Inc.
8	* Copyright (c) 1998-2000 Scriptics Corporation.
9	*
10	* See the file "license.terms" for information on usage and redistribution
11	* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
12	*
13	* RCS: @(#) $Id: tclwin32dll.c,v 1.1.1.1 2001/06/13 04:48:12 dtashley Exp $
14	*/
15
16	#include "tclWinInt.h"
17
18	/*
19	* The following data structures are used when loading the thunking
20	* library for execing child processes under Win32s.
21	*/
22
23	typedef DWORD (WINAPI UT32PROC)(LPVOID lpBuff, DWORD dwUserDefined,
24	LPVOID *lpTranslationList);
25
26	typedef BOOL (WINAPI UTREGISTER)(HANDLE hModule, LPCSTR SixteenBitDLL,
27	LPCSTR InitName, LPCSTR ProcName, UT32PROC **ThirtyTwoBitThunk,
28	FARPROC UT32Callback, LPVOID Buff);
29
30	typedef VOID (WINAPI UTUNREGISTER)(HANDLE hModule);
31
32	/*
33	* The following variables keep track of information about this DLL
34	* on a per-instance basis. Each time this DLL is loaded, it gets its own
35	* new data segment with its own copy of all static and global information.
36	*/
37
38	static HINSTANCE hInstance; /* HINSTANCE of this DLL. */
39	static int platformId; /* Running under NT, or 95/98? */
40
41	/*
42	* The following function tables are used to dispatch to either the
43	* wide-character or multi-byte versions of the operating system calls,
44	* depending on whether the Unicode calls are available.
45	*/
46
47	static TclWinProcs asciiProcs = {
48	0,
49
50	(BOOL (WINAPI )(CONST TCHAR , LPDCB)) BuildCommDCBA,
51	(TCHAR (WINAPI )(TCHAR *)) CharLowerA,
52	(BOOL (WINAPI )(CONST TCHAR , CONST TCHAR *, BOOL)) CopyFileA,
53	(BOOL (WINAPI )(CONST TCHAR , LPSECURITY_ATTRIBUTES)) CreateDirectoryA,
54	(HANDLE (WINAPI )(CONST TCHAR , DWORD, DWORD, SECURITY_ATTRIBUTES *,
55	DWORD, DWORD, HANDLE)) CreateFileA,
56	(BOOL (WINAPI )(CONST TCHAR , TCHAR *, LPSECURITY_ATTRIBUTES,
57	LPSECURITY_ATTRIBUTES, BOOL, DWORD, LPVOID, CONST TCHAR *,
58	LPSTARTUPINFOA, LPPROCESS_INFORMATION)) CreateProcessA,
59	(BOOL (WINAPI )(CONST TCHAR )) DeleteFileA,
60	(HANDLE (WINAPI )(CONST TCHAR , WIN32_FIND_DATAT *)) FindFirstFileA,
61	(BOOL (WINAPI )(HANDLE, WIN32_FIND_DATAT )) FindNextFileA,
62	(BOOL (WINAPI )(WCHAR , LPDWORD)) GetComputerNameA,
63	(DWORD (WINAPI )(DWORD, WCHAR )) GetCurrentDirectoryA,
64	(DWORD (WINAPI )(CONST TCHAR )) GetFileAttributesA,
65	(DWORD (WINAPI )(CONST TCHAR , DWORD nBufferLength, WCHAR *,
66	TCHAR **)) GetFullPathNameA,
67	(DWORD (WINAPI )(HMODULE, WCHAR , int)) GetModuleFileNameA,
68	(DWORD (WINAPI )(CONST TCHAR , WCHAR *, DWORD)) GetShortPathNameA,
69	(UINT (WINAPI )(CONST TCHAR , CONST TCHAR *, UINT uUnique,
70	WCHAR *)) GetTempFileNameA,
71	(DWORD (WINAPI )(DWORD, WCHAR )) GetTempPathA,
72	(BOOL (WINAPI )(CONST TCHAR , WCHAR *, DWORD, LPDWORD, LPDWORD, LPDWORD,
73	WCHAR *, DWORD)) GetVolumeInformationA,
74	(HINSTANCE (WINAPI )(CONST TCHAR )) LoadLibraryA,
75	(TCHAR (WINAPI )(WCHAR , CONST TCHAR *)) lstrcpyA,
76	(BOOL (WINAPI )(CONST TCHAR , CONST TCHAR *)) MoveFileA,
77	(BOOL (WINAPI )(CONST TCHAR )) RemoveDirectoryA,
78	(DWORD (WINAPI )(CONST TCHAR , CONST TCHAR , CONST TCHAR , DWORD,
79	WCHAR , TCHAR *)) SearchPathA,
80	(BOOL (WINAPI )(CONST TCHAR )) SetCurrentDirectoryA,
81	(BOOL (WINAPI )(CONST TCHAR , DWORD)) SetFileAttributesA,
82	};
83
84	static TclWinProcs unicodeProcs = {
85	1,
86
87	(BOOL (WINAPI )(CONST TCHAR , LPDCB)) BuildCommDCBW,
88	(TCHAR (WINAPI )(TCHAR *)) CharLowerW,
89	(BOOL (WINAPI )(CONST TCHAR , CONST TCHAR *, BOOL)) CopyFileW,
90	(BOOL (WINAPI )(CONST TCHAR , LPSECURITY_ATTRIBUTES)) CreateDirectoryW,
91	(HANDLE (WINAPI )(CONST TCHAR , DWORD, DWORD, SECURITY_ATTRIBUTES *,
92	DWORD, DWORD, HANDLE)) CreateFileW,
93	(BOOL (WINAPI )(CONST TCHAR , TCHAR *, LPSECURITY_ATTRIBUTES,
94	LPSECURITY_ATTRIBUTES, BOOL, DWORD, LPVOID, CONST TCHAR *,
95	LPSTARTUPINFOA, LPPROCESS_INFORMATION)) CreateProcessW,
96	(BOOL (WINAPI )(CONST TCHAR )) DeleteFileW,
97	(HANDLE (WINAPI )(CONST TCHAR , WIN32_FIND_DATAT *)) FindFirstFileW,
98	(BOOL (WINAPI )(HANDLE, WIN32_FIND_DATAT )) FindNextFileW,
99	(BOOL (WINAPI )(WCHAR , LPDWORD)) GetComputerNameW,
100	(DWORD (WINAPI )(DWORD, WCHAR )) GetCurrentDirectoryW,
101	(DWORD (WINAPI )(CONST TCHAR )) GetFileAttributesW,
102	(DWORD (WINAPI )(CONST TCHAR , DWORD nBufferLength, WCHAR *,
103	TCHAR **)) GetFullPathNameW,
104	(DWORD (WINAPI )(HMODULE, WCHAR , int)) GetModuleFileNameW,
105	(DWORD (WINAPI )(CONST TCHAR , WCHAR *, DWORD)) GetShortPathNameW,
106	(UINT (WINAPI )(CONST TCHAR , CONST TCHAR *, UINT uUnique,
107	WCHAR *)) GetTempFileNameW,
108	(DWORD (WINAPI )(DWORD, WCHAR )) GetTempPathW,
109	(BOOL (WINAPI )(CONST TCHAR , WCHAR *, DWORD, LPDWORD, LPDWORD, LPDWORD,
110	WCHAR *, DWORD)) GetVolumeInformationW,
111	(HINSTANCE (WINAPI )(CONST TCHAR )) LoadLibraryW,
112	(TCHAR (WINAPI )(WCHAR , CONST TCHAR *)) lstrcpyW,
113	(BOOL (WINAPI )(CONST TCHAR , CONST TCHAR *)) MoveFileW,
114	(BOOL (WINAPI )(CONST TCHAR )) RemoveDirectoryW,
115	(DWORD (WINAPI )(CONST TCHAR , CONST TCHAR , CONST TCHAR , DWORD,
116	WCHAR , TCHAR *)) SearchPathW,
117	(BOOL (WINAPI )(CONST TCHAR )) SetCurrentDirectoryW,
118	(BOOL (WINAPI )(CONST TCHAR , DWORD)) SetFileAttributesW,
119	};
120
121	TclWinProcs *tclWinProcs;
122	static Tcl_Encoding tclWinTCharEncoding;
123
124	/*
125	* The following declaration is for the VC++ DLL entry point.
126	*/
127
128	BOOL APIENTRY DllMain(HINSTANCE hInst, DWORD reason,
129	LPVOID reserved);
130
131
132	#ifdef __WIN32__
133	#ifndef STATIC_BUILD
134
135
136	/*
137	*----------------------------------------------------------------------
138	*
139	* DllEntryPoint --
140	*
141	* This wrapper function is used by Borland to invoke the
142	* initialization code for Tcl. It simply calls the DllMain
143	* routine.
144	*
145	* Results:
146	* See DllMain.
147	*
148	* Side effects:
149	* See DllMain.
150	*
151	*----------------------------------------------------------------------
152	*/
153
154	BOOL APIENTRY
155	DllEntryPoint(hInst, reason, reserved)
156	HINSTANCE hInst; /* Library instance handle. */
157	DWORD reason; /* Reason this function is being called. */
158	LPVOID reserved; /* Not used. */
159	{
160	return DllMain(hInst, reason, reserved);
161	}
162
163	/*
164	*----------------------------------------------------------------------
165	*
166	* DllMain --
167	*
168	* This routine is called by the VC++ C run time library init
169	* code, or the DllEntryPoint routine. It is responsible for
170	* initializing various dynamically loaded libraries.
171	*
172	* Results:
173	* TRUE on sucess, FALSE on failure.
174	*
175	* Side effects:
176	* Establishes 32-to-16 bit thunk and initializes sockets library.
177	*
178	*----------------------------------------------------------------------
179	*/
180	BOOL APIENTRY
181	DllMain(hInst, reason, reserved)
182	HINSTANCE hInst; /* Library instance handle. */
183	DWORD reason; /* Reason this function is being called. */
184	LPVOID reserved; /* Not used. */
185	{
186	switch (reason) {
187	case DLL_PROCESS_ATTACH:
188	TclWinInit(hInst);
189	return TRUE;
190
191	case DLL_PROCESS_DETACH:
192	if (hInst == hInstance) {
193	Tcl_Finalize();
194	}
195	break;
196	}
197
198	return TRUE;
199	}
200
201	#endif /* !STATIC_BUILD */
202	#endif /* __WIN32__ */
203
204	/*
205	*----------------------------------------------------------------------
206	*
207	* TclWinGetTclInstance --
208	*
209	* Retrieves the global library instance handle.
210	*
211	* Results:
212	* Returns the global library instance handle.
213	*
214	* Side effects:
215	* None.
216	*
217	*----------------------------------------------------------------------
218	*/
219
220	HINSTANCE
221	TclWinGetTclInstance()
222	{
223	return hInstance;
224	}
225
226	/*
227	*----------------------------------------------------------------------
228	*
229	* TclWinInit --
230	*
231	* This function initializes the internal state of the tcl library.
232	*
233	* Results:
234	* None.
235	*
236	* Side effects:
237	* Initializes the tclPlatformId variable.
238	*
239	*----------------------------------------------------------------------
240	*/
241
242	void
243	TclWinInit(hInst)
244	HINSTANCE hInst; /* Library instance handle. */
245	{
246	OSVERSIONINFO os;
247
248	hInstance = hInst;
249	os.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
250	GetVersionEx(&os);
251	platformId = os.dwPlatformId;
252
253	/*
254	* We no longer support Win32s, so just in case someone manages to
255	* get a runtime there, make sure they know that.
256	*/
257
258	if (platformId == VER_PLATFORM_WIN32s) {
259	panic("Win32s is not a supported platform");
260	}
261
262	tclWinProcs = &asciiProcs;
263	}
264
265	/*
266	*----------------------------------------------------------------------
267	*
268	* TclWinGetPlatformId --
269	*
270	* Determines whether running under NT, 95, or Win32s, to allow
271	* runtime conditional code.
272	*
273	* Results:
274	* The return value is one of:
275	* VER_PLATFORM_WIN32s Win32s on Windows 3.1. (not supported)
276	* VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 95.
277	* VER_PLATFORM_WIN32_NT Win32 on Windows NT
278	*
279	* Side effects:
280	* None.
281	*
282	*----------------------------------------------------------------------
283	*/
284
285	int
286	TclWinGetPlatformId()
287	{
288	return platformId;
289	}
290
291	/*
292	*-------------------------------------------------------------------------
293	*
294	* TclWinNoBackslash --
295	*
296	* We're always iterating through a string in Windows, changing the
297	* backslashes to slashes for use in Tcl.
298	*
299	* Results:
300	* All backslashes in given string are changed to slashes.
301	*
302	* Side effects:
303	* None.
304	*
305	*-------------------------------------------------------------------------
306	*/
307
308	char *
309	TclWinNoBackslash(
310	char path) / String to change. */
311	{
312	char *p;
313
314	for (p = path; *p != '\0'; p++) {
315	if (*p == '\\') {
316	*p = '/';
317	}
318	}
319	return path;
320	}
321
322	/*
323	*----------------------------------------------------------------------
324	*
325	* TclpCheckStackSpace --
326	*
327	* Detect if we are about to blow the stack. Called before an
328	* evaluation can happen when nesting depth is checked.
329	*
330	* Results:
331	* 1 if there is enough stack space to continue; 0 if not.
332	*
333	* Side effects:
334	* None.
335	*
336	*----------------------------------------------------------------------
337	*/
338
339	int
340	TclpCheckStackSpace()
341	{
342	/*
343	* We can recurse only if there is at least TCL_WIN_STACK_THRESHOLD
344	* bytes of stack space left. alloca() is cheap on windows; basically
345	* it just subtracts from the stack pointer causing the OS to throw an
346	* exception if the stack pointer is set below the bottom of the stack.
347	*/
348
349	__try {
350	alloca(TCL_WIN_STACK_THRESHOLD);
351	return 1;
352	} __except (1) {}
353
354	return 0;
355	}
356
357
358	/*
359	*----------------------------------------------------------------------
360	*
361	* TclWinGetPlatform --
362	*
363	* This is a kludge that allows the test library to get access
364	* the internal tclPlatform variable.
365	*
366	* Results:
367	* Returns a pointer to the tclPlatform variable.
368	*
369	* Side effects:
370	* None.
371	*
372	*----------------------------------------------------------------------
373	*/
374
375	TclPlatformType *
376	TclWinGetPlatform()
377	{
378	return &tclPlatform;
379	}
380
381	/*
382	*---------------------------------------------------------------------------
383	*
384	* TclWinSetInterfaces --
385	*
386	* A helper proc that allows the test library to change the
387	* tclWinProcs structure to dispatch to either the wide-character
388	* or multi-byte versions of the operating system calls, depending
389	* on whether Unicode is the system encoding.
390	*
391	* Results:
392	* None.
393	*
394	* Side effects:
395	* None.
396	*
397	*---------------------------------------------------------------------------
398	*/
399
400	void
401	TclWinSetInterfaces(
402	int wide) /* Non-zero to use wide interfaces, 0
403	* otherwise. */
404	{
405	Tcl_FreeEncoding(tclWinTCharEncoding);
406
407	if (wide) {
408	tclWinProcs = &unicodeProcs;
409	tclWinTCharEncoding = Tcl_GetEncoding(NULL, "unicode");
410	} else {
411	tclWinProcs = &asciiProcs;
412	tclWinTCharEncoding = NULL;
413	}
414	}
415
416	/*
417	*---------------------------------------------------------------------------
418	*
419	* Tcl_WinUtfToTChar, Tcl_WinTCharToUtf --
420	*
421	* Convert between UTF-8 and Unicode when running Windows NT or
422	* the current ANSI code page when running Windows 95.
423	*
424	* On Mac, Unix, and Windows 95, all strings exchanged between Tcl
425	* and the OS are "char" oriented. We need only one Tcl_Encoding to
426	* convert between UTF-8 and the system's native encoding. We use
427	* NULL to represent that encoding.
428	*
429	* On NT, some strings exchanged between Tcl and the OS are "char"
430	* oriented, while others are in Unicode. We need two Tcl_Encoding
431	* APIs depending on whether we are targeting a "char" or Unicode
432	* interface.
433	*
434	* Calling Tcl_UtfToExternal() or Tcl_ExternalToUtf() with an
435	* encoding of NULL should always used to convert between UTF-8
436	* and the system's "char" oriented encoding. The following two
437	* functions are used in Windows-specific code to convert between
438	* UTF-8 and Unicode strings (NT) or "char" strings(95). This saves
439	* you the trouble of writing the following type of fragment over and
440	* over:
441	*
442	* if (running NT) {
443	* encoding <- Tcl_GetEncoding("unicode");
444	* nativeBuffer <- UtfToExternal(encoding, utfBuffer);
445	* Tcl_FreeEncoding(encoding);
446	* } else {
447	* nativeBuffer <- UtfToExternal(NULL, utfBuffer);
448	* }
449	*
450	* By convention, in Windows a TCHAR is a character in the ANSI code
451	* page on Windows 95, a Unicode character on Windows NT. If you
452	* plan on targeting a Unicode interfaces when running on NT and a
453	* "char" oriented interface while running on 95, these functions
454	* should be used. If you plan on targetting the same "char"
455	* oriented function on both 95 and NT, use Tcl_UtfToExternal()
456	* with an encoding of NULL.
457	*
458	* Results:
459	* The result is a pointer to the string in the desired target
460	* encoding. Storage for the result string is allocated in
461	* dsPtr; the caller must call Tcl_DStringFree() when the result
462	* is no longer needed.
463	*
464	* Side effects:
465	* None.
466	*
467	*---------------------------------------------------------------------------
468	*/
469
470	TCHAR *
471	Tcl_WinUtfToTChar(string, len, dsPtr)
472	CONST char string; / Source string in UTF-8. */
473	int len; /* Source string length in bytes, or < 0 for
474	* strlen(). */
475	Tcl_DString dsPtr; / Uninitialized or free DString in which
476	* the converted string is stored. */
477	{
478	return (TCHAR *) Tcl_UtfToExternalDString(tclWinTCharEncoding,
479	string, len, dsPtr);
480	}
481
482	char *
483	Tcl_WinTCharToUtf(string, len, dsPtr)
484	CONST TCHAR string; / Source string in Unicode when running
485	* NT, ANSI when running 95. */
486	int len; /* Source string length in bytes, or < 0 for
487	* platform-specific string length. */
488	Tcl_DString dsPtr; / Uninitialized or free DString in which
489	* the converted string is stored. */
490	{
491	return Tcl_ExternalToUtfDString(tclWinTCharEncoding,
492	(CONST char *) string, len, dsPtr);
493	}
494
495	/* End of tclwin32dll.c */