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