Planet
navi homePPSaboutscreenshotsdownloaddevelopmentforum

source: downloads/tcl8.5.2/win/tclWin32Dll.c @ 25

Last change on this file since 25 was 25, checked in by landauf, 16 years ago

added tcl to libs

File size: 34.2 KB
Line 
1/*
2 * tclWin32Dll.c --
3 *
4 *      This file contains the DLL entry point and other low-level bit bashing
5 *      code that needs inline assembly.
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 of
11 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
12 *
13 * RCS: @(#) $Id: tclWin32Dll.c,v 1.54 2007/12/13 15:28:43 dgp Exp $
14 */
15
16#include "tclWinInt.h"
17
18#ifndef TCL_NO_STACK_CHECK
19/*
20 * The following functions implement stack depth checking
21 */
22typedef struct ThreadSpecificData {
23    int *stackBound;            /* The current stack boundary */
24} ThreadSpecificData;
25static Tcl_ThreadDataKey dataKey;
26#endif /* TCL_NO_STACK_CHECK */
27
28/*
29 * The following data structures are used when loading the thunking library
30 * for execing child processes under Win32s.
31 */
32
33typedef DWORD (WINAPI UT32PROC)(LPVOID lpBuff, DWORD dwUserDefined,
34        LPVOID *lpTranslationList);
35
36typedef BOOL (WINAPI UTREGISTER)(HANDLE hModule, LPCSTR SixteenBitDLL,
37        LPCSTR InitName, LPCSTR ProcName, UT32PROC **ThirtyTwoBitThunk,
38        FARPROC UT32Callback, LPVOID Buff);
39
40typedef VOID (WINAPI UTUNREGISTER)(HANDLE hModule);
41
42/*
43 * The following variables keep track of information about this DLL on a
44 * per-instance basis. Each time this DLL is loaded, it gets its own new data
45 * segment with its own copy of all static and global information.
46 */
47
48static HINSTANCE hInstance;     /* HINSTANCE of this DLL. */
49static int platformId;          /* Running under NT, or 95/98? */
50
51#ifdef HAVE_NO_SEH
52/*
53 * Unlike Borland and Microsoft, we don't register exception handlers by
54 * pushing registration records onto the runtime stack. Instead, we register
55 * them by creating an EXCEPTION_REGISTRATION within the activation record.
56 */
57
58typedef struct EXCEPTION_REGISTRATION {
59    struct EXCEPTION_REGISTRATION *link;
60    EXCEPTION_DISPOSITION (*handler)(
61            struct _EXCEPTION_RECORD*, void*, struct _CONTEXT*, void*);
62    void *ebp;
63    void *esp;
64    int status;
65} EXCEPTION_REGISTRATION;
66#endif
67
68/*
69 * VC++ 5.x has no 'cpuid' assembler instruction, so we must emulate it
70 */
71
72#if defined(_MSC_VER) && (_MSC_VER <= 1100)
73#define cpuid   __asm __emit 0fh __asm __emit 0a2h
74#endif
75
76/*
77 * The following function tables are used to dispatch to either the
78 * wide-character or multi-byte versions of the operating system calls,
79 * depending on whether the Unicode calls are available.
80 */
81
82static TclWinProcs asciiProcs = {
83    0,
84
85    (BOOL (WINAPI *)(CONST TCHAR *, LPDCB)) BuildCommDCBA,
86    (TCHAR *(WINAPI *)(TCHAR *)) CharLowerA,
87    (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *, BOOL)) CopyFileA,
88    (BOOL (WINAPI *)(CONST TCHAR *, LPSECURITY_ATTRIBUTES)) CreateDirectoryA,
89    (HANDLE (WINAPI *)(CONST TCHAR *, DWORD, DWORD, SECURITY_ATTRIBUTES *,
90            DWORD, DWORD, HANDLE)) CreateFileA,
91    (BOOL (WINAPI *)(CONST TCHAR *, TCHAR *, LPSECURITY_ATTRIBUTES,
92            LPSECURITY_ATTRIBUTES, BOOL, DWORD, LPVOID, CONST TCHAR *,
93            LPSTARTUPINFOA, LPPROCESS_INFORMATION)) CreateProcessA,
94    (BOOL (WINAPI *)(CONST TCHAR *)) DeleteFileA,
95    (HANDLE (WINAPI *)(CONST TCHAR *, WIN32_FIND_DATAT *)) FindFirstFileA,
96    (BOOL (WINAPI *)(HANDLE, WIN32_FIND_DATAT *)) FindNextFileA,
97    (BOOL (WINAPI *)(WCHAR *, LPDWORD)) GetComputerNameA,
98    (DWORD (WINAPI *)(DWORD, WCHAR *)) GetCurrentDirectoryA,
99    (DWORD (WINAPI *)(CONST TCHAR *)) GetFileAttributesA,
100    (DWORD (WINAPI *)(CONST TCHAR *, DWORD nBufferLength, WCHAR *,
101            TCHAR **)) GetFullPathNameA,
102    (DWORD (WINAPI *)(HMODULE, WCHAR *, int)) GetModuleFileNameA,
103    (DWORD (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD)) GetShortPathNameA,
104    (UINT (WINAPI *)(CONST TCHAR *, CONST TCHAR *, UINT uUnique,
105            WCHAR *)) GetTempFileNameA,
106    (DWORD (WINAPI *)(DWORD, WCHAR *)) GetTempPathA,
107    (BOOL (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD, LPDWORD, LPDWORD, LPDWORD,
108            WCHAR *, DWORD)) GetVolumeInformationA,
109    (HINSTANCE (WINAPI *)(CONST TCHAR *)) LoadLibraryA,
110    (TCHAR (WINAPI *)(WCHAR *, CONST TCHAR *)) lstrcpyA,
111    (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *)) MoveFileA,
112    (BOOL (WINAPI *)(CONST TCHAR *)) RemoveDirectoryA,
113    (DWORD (WINAPI *)(CONST TCHAR *, CONST TCHAR *, CONST TCHAR *, DWORD,
114            WCHAR *, TCHAR **)) SearchPathA,
115    (BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryA,
116    (BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesA,
117
118    /*
119     * The three NULL function pointers will only be set when
120     * Tcl_FindExecutable is called. If you don't ever call that function, the
121     * application will crash whenever WinTcl tries to call functions through
122     * these null pointers. That is not a bug in Tcl - Tcl_FindExecutable is
123     * mandatory in recent Tcl releases.
124     */
125
126    NULL,
127    NULL,
128    /* deleted (int (__cdecl*)(CONST TCHAR *, struct _utimbuf *)) _utime, */
129    NULL,
130    NULL,
131    /* getLongPathNameProc */
132    NULL,
133    /* Security SDK - not available on 95,98,ME */
134    NULL, NULL, NULL, NULL, NULL, NULL,
135    /* ReadConsole and WriteConsole */
136    (BOOL (WINAPI *)(HANDLE, LPVOID, DWORD, LPDWORD, LPVOID)) ReadConsoleA,
137    (BOOL (WINAPI *)(HANDLE, const VOID*, DWORD, LPDWORD, LPVOID)) WriteConsoleA
138};
139
140static TclWinProcs unicodeProcs = {
141    1,
142
143    (BOOL (WINAPI *)(CONST TCHAR *, LPDCB)) BuildCommDCBW,
144    (TCHAR *(WINAPI *)(TCHAR *)) CharLowerW,
145    (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *, BOOL)) CopyFileW,
146    (BOOL (WINAPI *)(CONST TCHAR *, LPSECURITY_ATTRIBUTES)) CreateDirectoryW,
147    (HANDLE (WINAPI *)(CONST TCHAR *, DWORD, DWORD, SECURITY_ATTRIBUTES *,
148            DWORD, DWORD, HANDLE)) CreateFileW,
149    (BOOL (WINAPI *)(CONST TCHAR *, TCHAR *, LPSECURITY_ATTRIBUTES,
150            LPSECURITY_ATTRIBUTES, BOOL, DWORD, LPVOID, CONST TCHAR *,
151            LPSTARTUPINFOA, LPPROCESS_INFORMATION)) CreateProcessW,
152    (BOOL (WINAPI *)(CONST TCHAR *)) DeleteFileW,
153    (HANDLE (WINAPI *)(CONST TCHAR *, WIN32_FIND_DATAT *)) FindFirstFileW,
154    (BOOL (WINAPI *)(HANDLE, WIN32_FIND_DATAT *)) FindNextFileW,
155    (BOOL (WINAPI *)(WCHAR *, LPDWORD)) GetComputerNameW,
156    (DWORD (WINAPI *)(DWORD, WCHAR *)) GetCurrentDirectoryW,
157    (DWORD (WINAPI *)(CONST TCHAR *)) GetFileAttributesW,
158    (DWORD (WINAPI *)(CONST TCHAR *, DWORD nBufferLength, WCHAR *,
159            TCHAR **)) GetFullPathNameW,
160    (DWORD (WINAPI *)(HMODULE, WCHAR *, int)) GetModuleFileNameW,
161    (DWORD (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD)) GetShortPathNameW,
162    (UINT (WINAPI *)(CONST TCHAR *, CONST TCHAR *, UINT uUnique,
163            WCHAR *)) GetTempFileNameW,
164    (DWORD (WINAPI *)(DWORD, WCHAR *)) GetTempPathW,
165    (BOOL (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD, LPDWORD, LPDWORD, LPDWORD,
166            WCHAR *, DWORD)) GetVolumeInformationW,
167    (HINSTANCE (WINAPI *)(CONST TCHAR *)) LoadLibraryW,
168    (TCHAR (WINAPI *)(WCHAR *, CONST TCHAR *)) lstrcpyW,
169    (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *)) MoveFileW,
170    (BOOL (WINAPI *)(CONST TCHAR *)) RemoveDirectoryW,
171    (DWORD (WINAPI *)(CONST TCHAR *, CONST TCHAR *, CONST TCHAR *, DWORD,
172            WCHAR *, TCHAR **)) SearchPathW,
173    (BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryW,
174    (BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesW,
175
176    /*
177     * The three NULL function pointers will only be set when
178     * Tcl_FindExecutable is called. If you don't ever call that function, the
179     * application will crash whenever WinTcl tries to call functions through
180     * these null pointers. That is not a bug in Tcl - Tcl_FindExecutable is
181     * mandatory in recent Tcl releases.
182     */
183
184    NULL,
185    NULL,
186    /* deleted (int (__cdecl*)(CONST TCHAR *, struct _utimbuf *)) _wutime, */
187    NULL,
188    NULL,
189    /* getLongPathNameProc */
190    NULL,
191    /* Security SDK - will be filled in on NT,XP,2000,2003 */
192    NULL, NULL, NULL, NULL, NULL, NULL,
193    /* ReadConsole and WriteConsole */
194    (BOOL (WINAPI *)(HANDLE, LPVOID, DWORD, LPDWORD, LPVOID)) ReadConsoleW,
195    (BOOL (WINAPI *)(HANDLE, const VOID*, DWORD, LPDWORD, LPVOID)) WriteConsoleW
196};
197
198TclWinProcs *tclWinProcs;
199static Tcl_Encoding tclWinTCharEncoding;
200
201#ifdef HAVE_NO_SEH
202/*
203 * Need to add noinline flag to DllMain declaration so that gcc -O3 does not
204 * inline asm code into DllEntryPoint and cause a compile time error because
205 * of redefined local labels.
206 */
207
208BOOL APIENTRY           DllMain(HINSTANCE hInst, DWORD reason,
209                            LPVOID reserved) __attribute__ ((noinline));
210#else
211/*
212 * The following declaration is for the VC++ DLL entry point.
213 */
214
215BOOL APIENTRY           DllMain(HINSTANCE hInst, DWORD reason,
216                            LPVOID reserved);
217#endif /* HAVE_NO_SEH */
218
219/*
220 * The following structure and linked list is to allow us to map between
221 * volume mount points and drive letters on the fly (no Win API exists for
222 * this).
223 */
224
225typedef struct MountPointMap {
226    CONST WCHAR *volumeName;    /* Native wide string volume name. */
227    char driveLetter;           /* Drive letter corresponding to the volume
228                                 * name. */
229    struct MountPointMap *nextPtr;
230                                /* Pointer to next structure in list, or
231                                 * NULL. */
232} MountPointMap;
233
234/*
235 * This is the head of the linked list, which is protected by the mutex which
236 * follows, for thread-enabled builds.
237 */
238
239MountPointMap *driveLetterLookup = NULL;
240TCL_DECLARE_MUTEX(mountPointMap)
241
242/*
243 * We will need this below.
244 */
245
246extern Tcl_FSDupInternalRepProc TclNativeDupInternalRep;
247
248#ifdef __WIN32__
249#ifndef STATIC_BUILD
250
251/*
252 *----------------------------------------------------------------------
253 *
254 * DllEntryPoint --
255 *
256 *      This wrapper function is used by Borland to invoke the initialization
257 *      code for Tcl. It simply calls the DllMain routine.
258 *
259 * Results:
260 *      See DllMain.
261 *
262 * Side effects:
263 *      See DllMain.
264 *
265 *----------------------------------------------------------------------
266 */
267
268BOOL APIENTRY
269DllEntryPoint(
270    HINSTANCE hInst,            /* Library instance handle. */
271    DWORD reason,               /* Reason this function is being called. */
272    LPVOID reserved)            /* Not used. */
273{
274    return DllMain(hInst, reason, reserved);
275}
276
277/*
278 *----------------------------------------------------------------------
279 *
280 * DllMain --
281 *
282 *      This routine is called by the VC++ C run time library init code, or
283 *      the DllEntryPoint routine. It is responsible for initializing various
284 *      dynamically loaded libraries.
285 *
286 * Results:
287 *      TRUE on sucess, FALSE on failure.
288 *
289 * Side effects:
290 *      Establishes 32-to-16 bit thunk and initializes sockets library. This
291 *      might call some sycronization functions, but MSDN documentation
292 *      states: "Waiting on synchronization objects in DllMain can cause a
293 *      deadlock."
294 *
295 *----------------------------------------------------------------------
296 */
297
298BOOL APIENTRY
299DllMain(
300    HINSTANCE hInst,            /* Library instance handle. */
301    DWORD reason,               /* Reason this function is being called. */
302    LPVOID reserved)            /* Not used. */
303{
304#ifdef HAVE_NO_SEH
305    EXCEPTION_REGISTRATION registration;
306#endif
307
308    switch (reason) {
309    case DLL_PROCESS_ATTACH:
310        DisableThreadLibraryCalls(hInst);
311        TclWinInit(hInst);
312        return TRUE;
313
314    case DLL_PROCESS_DETACH:
315        /*
316         * Protect the call to Tcl_Finalize. The OS could be unloading us from
317         * an exception handler and the state of the stack might be unstable.
318         */
319
320#ifdef HAVE_NO_SEH
321        __asm__ __volatile__ (
322
323            /*
324             * Construct an EXCEPTION_REGISTRATION to protect the call to
325             * Tcl_Finalize
326             */
327
328            "leal       %[registration], %%edx"         "\n\t"
329            "movl       %%fs:0,         %%eax"          "\n\t"
330            "movl       %%eax,          0x0(%%edx)"     "\n\t" /* link */
331            "leal       1f,             %%eax"          "\n\t"
332            "movl       %%eax,          0x4(%%edx)"     "\n\t" /* handler */
333            "movl       %%ebp,          0x8(%%edx)"     "\n\t" /* ebp */
334            "movl       %%esp,          0xc(%%edx)"     "\n\t" /* esp */
335            "movl       %[error],       0x10(%%edx)"    "\n\t" /* status */
336
337            /*
338             * Link the EXCEPTION_REGISTRATION on the chain
339             */
340
341            "movl       %%edx,          %%fs:0"         "\n\t"
342
343            /*
344             * Call Tcl_Finalize
345             */
346
347            "call       _Tcl_Finalize"                  "\n\t"
348
349            /*
350             * Come here on a normal exit. Recover the EXCEPTION_REGISTRATION
351             * and store a TCL_OK status
352             */
353
354            "movl       %%fs:0,         %%edx"          "\n\t"
355            "movl       %[ok],          %%eax"          "\n\t"
356            "movl       %%eax,          0x10(%%edx)"    "\n\t"
357            "jmp        2f"                             "\n"
358
359            /*
360             * Come here on an exception. Get the EXCEPTION_REGISTRATION that
361             * we previously put on the chain.
362             */
363
364            "1:"                                        "\t"
365            "movl       %%fs:0,         %%edx"          "\n\t"
366            "movl       0x8(%%edx),     %%edx"          "\n"
367
368
369            /*
370             * Come here however we exited. Restore context from the
371             * EXCEPTION_REGISTRATION in case the stack is unbalanced.
372             */
373
374            "2:"                                        "\t"
375            "movl       0xc(%%edx),     %%esp"          "\n\t"
376            "movl       0x8(%%edx),     %%ebp"          "\n\t"
377            "movl       0x0(%%edx),     %%eax"          "\n\t"
378            "movl       %%eax,          %%fs:0"         "\n\t"
379
380            :
381            /* No outputs */
382            :
383            [registration]      "m"     (registration),
384            [ok]                "i"     (TCL_OK),
385            [error]             "i"     (TCL_ERROR)
386            :
387            "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory"
388            );
389
390#else /* HAVE_NO_SEH */
391        __try {
392            Tcl_Finalize();
393        } __except (EXCEPTION_EXECUTE_HANDLER) {
394            /* empty handler body. */
395        }
396#endif
397
398        break;
399    }
400
401    return TRUE;
402}
403#endif /* !STATIC_BUILD */
404#endif /* __WIN32__ */
405
406/*
407 *----------------------------------------------------------------------
408 *
409 * TclWinGetTclInstance --
410 *
411 *      Retrieves the global library instance handle.
412 *
413 * Results:
414 *      Returns the global library instance handle.
415 *
416 * Side effects:
417 *      None.
418 *
419 *----------------------------------------------------------------------
420 */
421
422HINSTANCE
423TclWinGetTclInstance(void)
424{
425    return hInstance;
426}
427
428/*
429 *----------------------------------------------------------------------
430 *
431 * TclWinInit --
432 *
433 *      This function initializes the internal state of the tcl library.
434 *
435 * Results:
436 *      None.
437 *
438 * Side effects:
439 *      Initializes the tclPlatformId variable.
440 *
441 *----------------------------------------------------------------------
442 */
443
444void
445TclWinInit(
446    HINSTANCE hInst)            /* Library instance handle. */
447{
448    OSVERSIONINFO os;
449
450    hInstance = hInst;
451    os.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
452    GetVersionEx(&os);
453    platformId = os.dwPlatformId;
454
455    /*
456     * We no longer support Win32s, so just in case someone manages to get a
457     * runtime there, make sure they know that.
458     */
459
460    if (platformId == VER_PLATFORM_WIN32s) {
461        Tcl_Panic("Win32s is not a supported platform");
462    }
463
464    tclWinProcs = &asciiProcs;
465}
466
467/*
468 *----------------------------------------------------------------------
469 *
470 * TclWinGetPlatformId --
471 *
472 *      Determines whether running under NT, 95, or Win32s, to allow runtime
473 *      conditional code.
474 *
475 * Results:
476 *      The return value is one of:
477 *          VER_PLATFORM_WIN32s         Win32s on Windows 3.1. (not supported)
478 *          VER_PLATFORM_WIN32_WINDOWS  Win32 on Windows 95, 98, ME.
479 *          VER_PLATFORM_WIN32_NT       Win32 on Windows NT, 2000, XP
480 *
481 * Side effects:
482 *      None.
483 *
484 *----------------------------------------------------------------------
485 */
486
487int
488TclWinGetPlatformId(void)
489{
490    return platformId;
491}
492
493/*
494 *-------------------------------------------------------------------------
495 *
496 * TclWinNoBackslash --
497 *
498 *      We're always iterating through a string in Windows, changing the
499 *      backslashes to slashes for use in Tcl.
500 *
501 * Results:
502 *      All backslashes in given string are changed to slashes.
503 *
504 * Side effects:
505 *      None.
506 *
507 *-------------------------------------------------------------------------
508 */
509
510char *
511TclWinNoBackslash(
512    char *path)                 /* String to change. */
513{
514    char *p;
515
516    for (p = path; *p != '\0'; p++) {
517        if (*p == '\\') {
518            *p = '/';
519        }
520    }
521    return path;
522}
523
524/*
525 *----------------------------------------------------------------------
526 *
527 * TclpGetStackParams --
528 *
529 *      Determine the stack params for the current thread: in which
530 *      direction does the stack grow, and what is the stack lower (resp.
531 *      upper) bound for safe invocation of a new command? This is used to
532 *      cache the values needed for an efficient computation of
533 *      TclpCheckStackSpace() when the interp is known.
534 *
535 * Results:
536 *      Returns 1 if the stack grows down, in which case a stack lower bound
537 *      is stored at stackBoundPtr. If the stack grows up, 0 is returned and
538 *      an upper bound is stored at stackBoundPtr. If a bound cannot be
539 *      determined NULL is stored at stackBoundPtr.
540 *
541 *----------------------------------------------------------------------
542 */
543
544#ifndef TCL_NO_STACK_CHECK
545int
546TclpGetCStackParams(
547    int **stackBoundPtr)
548{
549    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
550    SYSTEM_INFO si;             /* The system information, used to
551                                 * determine the page size */
552    MEMORY_BASIC_INFORMATION mbi;
553                                /* The information about the memory
554                                 * area in which the stack resides */
555
556    if (!tsdPtr->stackBound
557        || ((UINT_PTR)&tsdPtr < (UINT_PTR)tsdPtr->stackBound)) {
558
559        /*
560         * Either we haven't determined the stack bound in this thread,
561         * or else we've overflowed the bound that we previously
562         * determined.  We need to find a new stack bound from
563         * Windows.
564         */
565
566        GetSystemInfo(&si);
567        if (VirtualQuery((LPCVOID) &tsdPtr, &mbi, sizeof(mbi)) == 0) {
568
569            /* For some reason, the system didn't let us query the
570             * stack size.  Nevertheless, we got here and haven't
571             * blown up yet.  Don't update the calculated stack bound.
572             * If there is no calculated stack bound yet, set it to
573             * the base of the current page of stack. */
574
575            if (!tsdPtr->stackBound) {
576                tsdPtr->stackBound =
577                    (int*) ((UINT_PTR)(&tsdPtr)
578                            & ~ (UINT_PTR)(si.dwPageSize - 1));
579            }
580
581        } else {
582
583            /* The allocation base of the stack segment has to be advanced
584             * by one page (to allow for the guard page maintained in the
585             * C runtime) and then by TCL_WIN_STACK_THRESHOLD (to allow
586             * for the amount of stack that Tcl needs).
587             */
588
589            tsdPtr->stackBound =
590                (int*) ((UINT_PTR)(mbi.AllocationBase)
591                        + (UINT_PTR)(si.dwPageSize)
592                        + TCL_WIN_STACK_THRESHOLD);
593        }
594    }
595    *stackBoundPtr = tsdPtr->stackBound;
596    return 1;
597}
598#endif
599
600
601/*
602 *---------------------------------------------------------------------------
603 *
604 * TclWinSetInterfaces --
605 *
606 *      A helper proc that allows the test library to change the tclWinProcs
607 *      structure to dispatch to either the wide-character or multi-byte
608 *      versions of the operating system calls, depending on whether Unicode
609 *      is the system encoding.
610 *
611 *      As well as this, we can also try to load in some additional procs
612 *      which may/may not be present depending on the current Windows version
613 *      (e.g. Win95 will not have the procs below).
614 *
615 * Results:
616 *      None.
617 *
618 * Side effects:
619 *      None.
620 *
621 *---------------------------------------------------------------------------
622 */
623
624void
625TclWinSetInterfaces(
626    int wide)                   /* Non-zero to use wide interfaces, 0
627                                 * otherwise. */
628{
629    Tcl_FreeEncoding(tclWinTCharEncoding);
630
631    if (wide) {
632        tclWinProcs = &unicodeProcs;
633        tclWinTCharEncoding = Tcl_GetEncoding(NULL, "unicode");
634        if (tclWinProcs->getFileAttributesExProc == NULL) {
635            HINSTANCE hInstance = LoadLibraryA("kernel32");
636            if (hInstance != NULL) {
637                tclWinProcs->getFileAttributesExProc =
638                        (BOOL (WINAPI *)(CONST TCHAR *, GET_FILEEX_INFO_LEVELS,
639                        LPVOID)) GetProcAddress(hInstance,
640                        "GetFileAttributesExW");
641                tclWinProcs->createHardLinkProc =
642                        (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR*,
643                        LPSECURITY_ATTRIBUTES)) GetProcAddress(hInstance,
644                        "CreateHardLinkW");
645                tclWinProcs->findFirstFileExProc =
646                        (HANDLE (WINAPI *)(CONST TCHAR*, UINT, LPVOID, UINT,
647                        LPVOID, DWORD)) GetProcAddress(hInstance,
648                        "FindFirstFileExW");
649                tclWinProcs->getVolumeNameForVMPProc =
650                        (BOOL (WINAPI *)(CONST TCHAR*, TCHAR*,
651                        DWORD)) GetProcAddress(hInstance,
652                        "GetVolumeNameForVolumeMountPointW");
653                tclWinProcs->getLongPathNameProc =
654                        (DWORD (WINAPI *)(CONST TCHAR*, TCHAR*,
655                        DWORD)) GetProcAddress(hInstance, "GetLongPathNameW");
656                FreeLibrary(hInstance);
657            }
658            hInstance = LoadLibraryA("advapi32");
659            if (hInstance != NULL) {
660                tclWinProcs->getFileSecurityProc = (BOOL (WINAPI *)(
661                        LPCTSTR lpFileName,
662                        SECURITY_INFORMATION RequestedInformation,
663                        PSECURITY_DESCRIPTOR pSecurityDescriptor,
664                        DWORD nLength, LPDWORD lpnLengthNeeded))
665                        GetProcAddress(hInstance, "GetFileSecurityW");
666                tclWinProcs->impersonateSelfProc = (BOOL (WINAPI *) (
667                        SECURITY_IMPERSONATION_LEVEL ImpersonationLevel))
668                        GetProcAddress(hInstance, "ImpersonateSelf");
669                tclWinProcs->openThreadTokenProc = (BOOL (WINAPI *) (
670                        HANDLE ThreadHandle, DWORD DesiredAccess,
671                        BOOL OpenAsSelf, PHANDLE TokenHandle))
672                        GetProcAddress(hInstance, "OpenThreadToken");
673                tclWinProcs->revertToSelfProc = (BOOL (WINAPI *) (void))
674                        GetProcAddress(hInstance, "RevertToSelf");
675                tclWinProcs->mapGenericMaskProc = (VOID (WINAPI *) (
676                        PDWORD AccessMask, PGENERIC_MAPPING GenericMapping))
677                        GetProcAddress(hInstance, "MapGenericMask");
678                tclWinProcs->accessCheckProc = (BOOL (WINAPI *)(
679                        PSECURITY_DESCRIPTOR pSecurityDescriptor,
680                        HANDLE ClientToken, DWORD DesiredAccess,
681                        PGENERIC_MAPPING GenericMapping,
682                        PPRIVILEGE_SET PrivilegeSet,
683                        LPDWORD PrivilegeSetLength, LPDWORD GrantedAccess,
684                        LPBOOL AccessStatus)) GetProcAddress(hInstance,
685                        "AccessCheck");
686                FreeLibrary(hInstance);
687            }
688        }
689    } else {
690        tclWinProcs = &asciiProcs;
691        tclWinTCharEncoding = NULL;
692        if (tclWinProcs->getFileAttributesExProc == NULL) {
693            HINSTANCE hInstance = LoadLibraryA("kernel32");
694            if (hInstance != NULL) {
695                tclWinProcs->getFileAttributesExProc =
696                        (BOOL (WINAPI *)(CONST TCHAR *, GET_FILEEX_INFO_LEVELS,
697                        LPVOID)) GetProcAddress(hInstance,
698                        "GetFileAttributesExA");
699                tclWinProcs->createHardLinkProc =
700                        (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR*,
701                        LPSECURITY_ATTRIBUTES)) GetProcAddress(hInstance,
702                        "CreateHardLinkA");
703                tclWinProcs->findFirstFileExProc = NULL;
704                tclWinProcs->getLongPathNameProc = NULL;
705                /*
706                 * The 'findFirstFileExProc' function exists on some of
707                 * 95/98/ME, but it seems not to work as anticipated.
708                 * Therefore we don't set this function pointer. The relevant
709                 * code will fall back on a slower approach using the normal
710                 * findFirstFileProc.
711                 *
712                 * (HANDLE (WINAPI *)(CONST TCHAR*, UINT,
713                 * LPVOID, UINT, LPVOID, DWORD)) GetProcAddress(hInstance,
714                 * "FindFirstFileExA");
715                 */
716                tclWinProcs->getVolumeNameForVMPProc =
717                        (BOOL (WINAPI *)(CONST TCHAR*, TCHAR*,
718                        DWORD)) GetProcAddress(hInstance,
719                        "GetVolumeNameForVolumeMountPointA");
720                FreeLibrary(hInstance);
721            }
722        }
723    }
724}
725
726/*
727 *---------------------------------------------------------------------------
728 *
729 * TclWinResetInterfaceEncodings --
730 *
731 *      Called during finalization to free up any encodings we use. The
732 *      tclWinProcs-> look up table is still ok to use after this call,
733 *      provided no encoding conversion is required.
734 *
735 *      We also clean up any memory allocated in our mount point map which is
736 *      used to follow certain kinds of symlinks. That code should never be
737 *      used once encodings are taken down.
738 *
739 * Results:
740 *      None.
741 *
742 * Side effects:
743 *      None.
744 *
745 *---------------------------------------------------------------------------
746 */
747
748void
749TclWinResetInterfaceEncodings(void)
750{
751    MountPointMap *dlIter, *dlIter2;
752    if (tclWinTCharEncoding != NULL) {
753        Tcl_FreeEncoding(tclWinTCharEncoding);
754        tclWinTCharEncoding = NULL;
755    }
756
757    /*
758     * Clean up the mount point map.
759     */
760
761    Tcl_MutexLock(&mountPointMap);
762    dlIter = driveLetterLookup;
763    while (dlIter != NULL) {
764        dlIter2 = dlIter->nextPtr;
765        ckfree((char*)dlIter->volumeName);
766        ckfree((char*)dlIter);
767        dlIter = dlIter2;
768    }
769    Tcl_MutexUnlock(&mountPointMap);
770}
771
772/*
773 *---------------------------------------------------------------------------
774 *
775 * TclWinResetInterfaces --
776 *
777 *      Called during finalization to reset us to a safe state for reuse.
778 *      After this call, it is best not to use the tclWinProcs-> look up table
779 *      since it is likely to be different to what is expected.
780 *
781 * Results:
782 *      None.
783 *
784 * Side effects:
785 *      None.
786 *
787 *---------------------------------------------------------------------------
788 */
789void
790TclWinResetInterfaces(void)
791{
792    tclWinProcs = &asciiProcs;
793}
794
795/*
796 *--------------------------------------------------------------------
797 *
798 * TclWinDriveLetterForVolMountPoint
799 *
800 *      Unfortunately, Windows provides no easy way at all to get hold of the
801 *      drive letter for a volume mount point, but we need that information to
802 *      understand paths correctly. So, we have to build an associated array
803 *      to find these correctly, and allow quick and easy lookup from volume
804 *      mount points to drive letters.
805 *
806 *      We assume here that we are running on a system for which the wide
807 *      character interfaces are used, which is valid for Win 2000 and WinXP
808 *      which are the only systems on which this function will ever be called.
809 *
810 * Result:
811 *      The drive letter, or -1 if no drive letter corresponds to the given
812 *      mount point.
813 *
814 *--------------------------------------------------------------------
815 */
816
817char
818TclWinDriveLetterForVolMountPoint(
819    CONST WCHAR *mountPoint)
820{
821    MountPointMap *dlIter, *dlPtr2;
822    WCHAR Target[55];           /* Target of mount at mount point */
823    WCHAR drive[4] = { L'A', L':', L'\\', L'\0' };
824
825    /*
826     * Detect the volume mounted there. Unfortunately, there is no simple way
827     * to map a unique volume name to a DOS drive letter. So, we have to build
828     * an associative array.
829     */
830
831    Tcl_MutexLock(&mountPointMap);
832    dlIter = driveLetterLookup;
833    while (dlIter != NULL) {
834        if (wcscmp(dlIter->volumeName, mountPoint) == 0) {
835            /*
836             * We need to check whether this information is still valid, since
837             * either the user or various programs could have adjusted the
838             * mount points on the fly.
839             */
840
841            drive[0] = L'A' + (dlIter->driveLetter - 'A');
842
843            /*
844             * Try to read the volume mount point and see where it points.
845             */
846
847            if ((*tclWinProcs->getVolumeNameForVMPProc)((TCHAR*)drive,
848                    (TCHAR*)Target, 55) != 0) {
849                if (wcscmp((WCHAR*)dlIter->volumeName, Target) == 0) {
850                    /*
851                     * Nothing has changed.
852                     */
853
854                    Tcl_MutexUnlock(&mountPointMap);
855                    return dlIter->driveLetter;
856                }
857            }
858
859            /*
860             * If we reach here, unfortunately, this mount point is no longer
861             * valid at all.
862             */
863
864            if (driveLetterLookup == dlIter) {
865                dlPtr2 = dlIter;
866                driveLetterLookup = dlIter->nextPtr;
867            } else {
868                for (dlPtr2 = driveLetterLookup;
869                        dlPtr2 != NULL; dlPtr2 = dlPtr2->nextPtr) {
870                    if (dlPtr2->nextPtr == dlIter) {
871                        dlPtr2->nextPtr = dlIter->nextPtr;
872                        dlPtr2 = dlIter;
873                        break;
874                    }
875                }
876            }
877
878            /*
879             * Now dlPtr2 points to the structure to free.
880             */
881
882            ckfree((char*)dlPtr2->volumeName);
883            ckfree((char*)dlPtr2);
884
885            /*
886             * Restart the loop - we could try to be clever and continue half
887             * way through, but the logic is a bit messy, so it's cleanest
888             * just to restart.
889             */
890
891            dlIter = driveLetterLookup;
892            continue;
893        }
894        dlIter = dlIter->nextPtr;
895    }
896
897    /*
898     * We couldn't find it, so we must iterate over the letters.
899     */
900
901    for (drive[0] = L'A'; drive[0] <= L'Z'; drive[0]++) {
902        /*
903         * Try to read the volume mount point and see where it points.
904         */
905
906        if ((*tclWinProcs->getVolumeNameForVMPProc)((TCHAR*)drive,
907                (TCHAR*)Target, 55) != 0) {
908            int alreadyStored = 0;
909
910            for (dlIter = driveLetterLookup; dlIter != NULL;
911                    dlIter = dlIter->nextPtr) {
912                if (wcscmp((WCHAR*)dlIter->volumeName, Target) == 0) {
913                    alreadyStored = 1;
914                    break;
915                }
916            }
917            if (!alreadyStored) {
918                dlPtr2 = (MountPointMap *) ckalloc(sizeof(MountPointMap));
919                dlPtr2->volumeName = TclNativeDupInternalRep(Target);
920                dlPtr2->driveLetter = 'A' + (drive[0] - L'A');
921                dlPtr2->nextPtr = driveLetterLookup;
922                driveLetterLookup  = dlPtr2;
923            }
924        }
925    }
926
927    /*
928     * Try again.
929     */
930
931    for (dlIter = driveLetterLookup; dlIter != NULL;
932            dlIter = dlIter->nextPtr) {
933        if (wcscmp(dlIter->volumeName, mountPoint) == 0) {
934            Tcl_MutexUnlock(&mountPointMap);
935            return dlIter->driveLetter;
936        }
937    }
938
939    /*
940     * The volume doesn't appear to correspond to a drive letter - we remember
941     * that fact and store '-1' so we don't have to look it up each time.
942     */
943
944    dlPtr2 = (MountPointMap*) ckalloc(sizeof(MountPointMap));
945    dlPtr2->volumeName = TclNativeDupInternalRep((ClientData)mountPoint);
946    dlPtr2->driveLetter = -1;
947    dlPtr2->nextPtr = driveLetterLookup;
948    driveLetterLookup  = dlPtr2;
949    Tcl_MutexUnlock(&mountPointMap);
950    return -1;
951}
952
953/*
954 *---------------------------------------------------------------------------
955 *
956 * Tcl_WinUtfToTChar, Tcl_WinTCharToUtf --
957 *
958 *      Convert between UTF-8 and Unicode when running Windows NT or the
959 *      current ANSI code page when running Windows 95.
960 *
961 *      On Mac, Unix, and Windows 95, all strings exchanged between Tcl and
962 *      the OS are "char" oriented. We need only one Tcl_Encoding to convert
963 *      between UTF-8 and the system's native encoding. We use NULL to
964 *      represent that encoding.
965 *
966 *      On NT, some strings exchanged between Tcl and the OS are "char"
967 *      oriented, while others are in Unicode. We need two Tcl_Encoding APIs
968 *      depending on whether we are targeting a "char" or Unicode interface.
969 *
970 *      Calling Tcl_UtfToExternal() or Tcl_ExternalToUtf() with an encoding of
971 *      NULL should always used to convert between UTF-8 and the system's
972 *      "char" oriented encoding. The following two functions are used in
973 *      Windows-specific code to convert between UTF-8 and Unicode strings
974 *      (NT) or "char" strings(95). This saves you the trouble of writing the
975 *      following type of fragment over and over:
976 *
977 *              if (running NT) {
978 *                  encoding <- Tcl_GetEncoding("unicode");
979 *                  nativeBuffer <- UtfToExternal(encoding, utfBuffer);
980 *                  Tcl_FreeEncoding(encoding);
981 *              } else {
982 *                  nativeBuffer <- UtfToExternal(NULL, utfBuffer);
983 *              }
984 *
985 *      By convention, in Windows a TCHAR is a character in the ANSI code page
986 *      on Windows 95, a Unicode character on Windows NT. If you plan on
987 *      targeting a Unicode interfaces when running on NT and a "char"
988 *      oriented interface while running on 95, these functions should be
989 *      used. If you plan on targetting the same "char" oriented function on
990 *      both 95 and NT, use Tcl_UtfToExternal() with an encoding of NULL.
991 *
992 * Results:
993 *      The result is a pointer to the string in the desired target encoding.
994 *      Storage for the result string is allocated in dsPtr; the caller must
995 *      call Tcl_DStringFree() when the result is no longer needed.
996 *
997 * Side effects:
998 *      None.
999 *
1000 *---------------------------------------------------------------------------
1001 */
1002
1003TCHAR *
1004Tcl_WinUtfToTChar(
1005    CONST char *string,         /* Source string in UTF-8. */
1006    int len,                    /* Source string length in bytes, or < 0 for
1007                                 * strlen(). */
1008    Tcl_DString *dsPtr)         /* Uninitialized or free DString in which the
1009                                 * converted string is stored. */
1010{
1011    return (TCHAR *) Tcl_UtfToExternalDString(tclWinTCharEncoding,
1012            string, len, dsPtr);
1013}
1014
1015char *
1016Tcl_WinTCharToUtf(
1017    CONST TCHAR *string,        /* Source string in Unicode when running NT,
1018                                 * ANSI when running 95. */
1019    int len,                    /* Source string length in bytes, or < 0 for
1020                                 * platform-specific string length. */
1021    Tcl_DString *dsPtr)         /* Uninitialized or free DString in which the
1022                                 * converted string is stored. */
1023{
1024    return Tcl_ExternalToUtfDString(tclWinTCharEncoding,
1025            (CONST char *) string, len, dsPtr);
1026}
1027
1028/*
1029 *------------------------------------------------------------------------
1030 *
1031 * TclWinCPUID --
1032 *
1033 *      Get CPU ID information on an Intel box under Windows
1034 *
1035 * Results:
1036 *      Returns TCL_OK if successful, TCL_ERROR if CPUID is not supported or
1037 *      fails.
1038 *
1039 * Side effects:
1040 *      If successful, stores EAX, EBX, ECX and EDX registers after the CPUID
1041 *      instruction in the four integers designated by 'regsPtr'
1042 *
1043 *----------------------------------------------------------------------
1044 */
1045
1046int
1047TclWinCPUID(
1048    unsigned int index,         /* Which CPUID value to retrieve. */
1049    unsigned int *regsPtr)      /* Registers after the CPUID. */
1050{
1051#ifdef HAVE_NO_SEH
1052    EXCEPTION_REGISTRATION registration;
1053#endif
1054    int status = TCL_ERROR;
1055
1056#if defined(__GNUC__) && !defined(_WIN64)
1057    /*
1058     * Execute the CPUID instruction with the given index, and store results
1059     * off 'regPtr'.
1060     */
1061
1062    __asm__ __volatile__(
1063        /*
1064         * Construct an EXCEPTION_REGISTRATION to protect the CPUID
1065         * instruction (early 486's don't have CPUID)
1066         */
1067
1068        "leal   %[registration], %%edx"         "\n\t"
1069        "movl   %%fs:0,         %%eax"          "\n\t"
1070        "movl   %%eax,          0x0(%%edx)"     "\n\t" /* link */
1071        "leal   1f,             %%eax"          "\n\t"
1072        "movl   %%eax,          0x4(%%edx)"     "\n\t" /* handler */
1073        "movl   %%ebp,          0x8(%%edx)"     "\n\t" /* ebp */
1074        "movl   %%esp,          0xc(%%edx)"     "\n\t" /* esp */
1075        "movl   %[error],       0x10(%%edx)"    "\n\t" /* status */
1076
1077        /*
1078         * Link the EXCEPTION_REGISTRATION on the chain
1079         */
1080
1081        "movl   %%edx,          %%fs:0"         "\n\t"
1082
1083        /*
1084         * Do the CPUID instruction, and save the results in the 'regsPtr'
1085         * area.
1086         */
1087
1088        "movl   %[rptr],        %%edi"          "\n\t"
1089        "movl   %[index],       %%eax"          "\n\t"
1090        "cpuid"                                 "\n\t"
1091        "movl   %%eax,          0x0(%%edi)"     "\n\t"
1092        "movl   %%ebx,          0x4(%%edi)"     "\n\t"
1093        "movl   %%ecx,          0x8(%%edi)"     "\n\t"
1094        "movl   %%edx,          0xc(%%edi)"     "\n\t"
1095
1096        /*
1097         * Come here on a normal exit. Recover the EXCEPTION_REGISTRATION and
1098         * store a TCL_OK status.
1099         */
1100
1101        "movl   %%fs:0,         %%edx"          "\n\t"
1102        "movl   %[ok],          %%eax"          "\n\t"
1103        "movl   %%eax,          0x10(%%edx)"    "\n\t"
1104        "jmp    2f"                             "\n"
1105
1106        /*
1107         * Come here on an exception. Get the EXCEPTION_REGISTRATION that we
1108         * previously put on the chain.
1109         */
1110
1111        "1:"                                    "\t"
1112        "movl   %%fs:0,         %%edx"          "\n\t"
1113        "movl   0x8(%%edx),     %%edx"          "\n\t"
1114
1115        /*
1116         * Come here however we exited. Restore context from the
1117         * EXCEPTION_REGISTRATION in case the stack is unbalanced.
1118         */
1119
1120        "2:"                                    "\t"
1121        "movl   0xc(%%edx),     %%esp"          "\n\t"
1122        "movl   0x8(%%edx),     %%ebp"          "\n\t"
1123        "movl   0x0(%%edx),     %%eax"          "\n\t"
1124        "movl   %%eax,          %%fs:0"         "\n\t"
1125
1126        :
1127        /* No outputs */
1128        :
1129        [index]         "m"     (index),
1130        [rptr]          "m"     (regsPtr),
1131        [registration]  "m"     (registration),
1132        [ok]            "i"     (TCL_OK),
1133        [error]         "i"     (TCL_ERROR)
1134        :
1135        "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory");
1136    status = registration.status;
1137
1138#elif defined(_MSC_VER) && !defined(_WIN64)
1139    /*
1140     * Define a structure in the stack frame to hold the registers.
1141     */
1142
1143    struct {
1144        DWORD dw0;
1145        DWORD dw1;
1146        DWORD dw2;
1147        DWORD dw3;
1148    } regs;
1149    regs.dw0 = index;
1150
1151    /*
1152     * Execute the CPUID instruction and save regs in the stack frame.
1153     */
1154
1155    _try {
1156        _asm {
1157            push    ebx
1158            push    ecx
1159            push    edx
1160            mov     eax, regs.dw0
1161            cpuid
1162            mov     regs.dw0, eax
1163            mov     regs.dw1, ebx
1164            mov     regs.dw2, ecx
1165            mov     regs.dw3, edx
1166            pop     edx
1167            pop     ecx
1168            pop     ebx
1169        }
1170
1171        /*
1172         * Copy regs back out to the caller.
1173         */
1174
1175        regsPtr[0] = regs.dw0;
1176        regsPtr[1] = regs.dw1;
1177        regsPtr[2] = regs.dw2;
1178        regsPtr[3] = regs.dw3;
1179
1180        status = TCL_OK;
1181    } __except(EXCEPTION_EXECUTE_HANDLER) {
1182        /* do nothing */
1183    }
1184
1185#else
1186    /*
1187     * Don't know how to do assembly code for this compiler and/or
1188     * architecture.
1189     */
1190#endif
1191    return status;
1192}
1193
1194/*
1195 * Local Variables:
1196 * mode: c
1197 * c-basic-offset: 4
1198 * fill-column: 78
1199 * End:
1200 */
Note: See TracBrowser for help on using the repository browser.