os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/win/tclWin32Dll.c
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/win/tclWin32Dll.c Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,1191 @@
1.4 +/*
1.5 + * tclWin32Dll.c --
1.6 + *
1.7 + * This file contains the DLL entry point.
1.8 + *
1.9 + * Copyright (c) 1995-1996 Sun Microsystems, Inc.
1.10 + * Copyright (c) 1998-2000 Scriptics Corporation.
1.11 + *
1.12 + * See the file "license.terms" for information on usage and redistribution
1.13 + * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.14 + *
1.15 + * RCS: @(#) $Id: tclWin32Dll.c,v 1.24.2.10 2006/10/17 04:36:45 dgp Exp $
1.16 + */
1.17 +
1.18 +#include "tclWinInt.h"
1.19 +
1.20 +/*
1.21 + * The following data structures are used when loading the thunking
1.22 + * library for execing child processes under Win32s.
1.23 + */
1.24 +
1.25 +typedef DWORD (WINAPI UT32PROC)(LPVOID lpBuff, DWORD dwUserDefined,
1.26 + LPVOID *lpTranslationList);
1.27 +
1.28 +typedef BOOL (WINAPI UTREGISTER)(HANDLE hModule, LPCSTR SixteenBitDLL,
1.29 + LPCSTR InitName, LPCSTR ProcName, UT32PROC **ThirtyTwoBitThunk,
1.30 + FARPROC UT32Callback, LPVOID Buff);
1.31 +
1.32 +typedef VOID (WINAPI UTUNREGISTER)(HANDLE hModule);
1.33 +
1.34 +/*
1.35 + * The following variables keep track of information about this DLL
1.36 + * on a per-instance basis. Each time this DLL is loaded, it gets its own
1.37 + * new data segment with its own copy of all static and global information.
1.38 + */
1.39 +
1.40 +static HINSTANCE hInstance; /* HINSTANCE of this DLL. */
1.41 +static int platformId; /* Running under NT, or 95/98? */
1.42 +
1.43 +#ifdef HAVE_NO_SEH
1.44 +
1.45 +/*
1.46 + * Unlike Borland and Microsoft, we don't register exception handlers
1.47 + * by pushing registration records onto the runtime stack. Instead, we
1.48 + * register them by creating an EXCEPTION_REGISTRATION within the activation
1.49 + * record.
1.50 + */
1.51 +
1.52 +typedef struct EXCEPTION_REGISTRATION {
1.53 + struct EXCEPTION_REGISTRATION* link;
1.54 + EXCEPTION_DISPOSITION (*handler)( struct _EXCEPTION_RECORD*, void*,
1.55 + struct _CONTEXT*, void* );
1.56 + void* ebp;
1.57 + void* esp;
1.58 + int status;
1.59 +} EXCEPTION_REGISTRATION;
1.60 +
1.61 +#endif
1.62 +
1.63 +/*
1.64 + * VC++ 5.x has no 'cpuid' assembler instruction, so we
1.65 + * must emulate it
1.66 + */
1.67 +#if defined(_MSC_VER) && ( _MSC_VER <= 1100 )
1.68 +#define cpuid __asm __emit 0fh __asm __emit 0a2h
1.69 +#endif
1.70 +
1.71 +/*
1.72 + * The following function tables are used to dispatch to either the
1.73 + * wide-character or multi-byte versions of the operating system calls,
1.74 + * depending on whether the Unicode calls are available.
1.75 + */
1.76 +
1.77 +static TclWinProcs asciiProcs = {
1.78 + 0,
1.79 +
1.80 + (BOOL (WINAPI *)(CONST TCHAR *, LPDCB)) BuildCommDCBA,
1.81 + (TCHAR *(WINAPI *)(TCHAR *)) CharLowerA,
1.82 + (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *, BOOL)) CopyFileA,
1.83 + (BOOL (WINAPI *)(CONST TCHAR *, LPSECURITY_ATTRIBUTES)) CreateDirectoryA,
1.84 + (HANDLE (WINAPI *)(CONST TCHAR *, DWORD, DWORD, SECURITY_ATTRIBUTES *,
1.85 + DWORD, DWORD, HANDLE)) CreateFileA,
1.86 + (BOOL (WINAPI *)(CONST TCHAR *, TCHAR *, LPSECURITY_ATTRIBUTES,
1.87 + LPSECURITY_ATTRIBUTES, BOOL, DWORD, LPVOID, CONST TCHAR *,
1.88 + LPSTARTUPINFOA, LPPROCESS_INFORMATION)) CreateProcessA,
1.89 + (BOOL (WINAPI *)(CONST TCHAR *)) DeleteFileA,
1.90 + (HANDLE (WINAPI *)(CONST TCHAR *, WIN32_FIND_DATAT *)) FindFirstFileA,
1.91 + (BOOL (WINAPI *)(HANDLE, WIN32_FIND_DATAT *)) FindNextFileA,
1.92 + (BOOL (WINAPI *)(WCHAR *, LPDWORD)) GetComputerNameA,
1.93 + (DWORD (WINAPI *)(DWORD, WCHAR *)) GetCurrentDirectoryA,
1.94 + (DWORD (WINAPI *)(CONST TCHAR *)) GetFileAttributesA,
1.95 + (DWORD (WINAPI *)(CONST TCHAR *, DWORD nBufferLength, WCHAR *,
1.96 + TCHAR **)) GetFullPathNameA,
1.97 + (DWORD (WINAPI *)(HMODULE, WCHAR *, int)) GetModuleFileNameA,
1.98 + (DWORD (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD)) GetShortPathNameA,
1.99 + (UINT (WINAPI *)(CONST TCHAR *, CONST TCHAR *, UINT uUnique,
1.100 + WCHAR *)) GetTempFileNameA,
1.101 + (DWORD (WINAPI *)(DWORD, WCHAR *)) GetTempPathA,
1.102 + (BOOL (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD, LPDWORD, LPDWORD, LPDWORD,
1.103 + WCHAR *, DWORD)) GetVolumeInformationA,
1.104 + (HINSTANCE (WINAPI *)(CONST TCHAR *)) LoadLibraryA,
1.105 + (TCHAR (WINAPI *)(WCHAR *, CONST TCHAR *)) lstrcpyA,
1.106 + (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *)) MoveFileA,
1.107 + (BOOL (WINAPI *)(CONST TCHAR *)) RemoveDirectoryA,
1.108 + (DWORD (WINAPI *)(CONST TCHAR *, CONST TCHAR *, CONST TCHAR *, DWORD,
1.109 + WCHAR *, TCHAR **)) SearchPathA,
1.110 + (BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryA,
1.111 + (BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesA,
1.112 + /*
1.113 + * The three NULL function pointers will only be set when
1.114 + * Tcl_FindExecutable is called. If you don't ever call that
1.115 + * function, the application will crash whenever WinTcl tries to call
1.116 + * functions through these null pointers. That is not a bug in Tcl
1.117 + * -- Tcl_FindExecutable is obligatory in recent Tcl releases.
1.118 + */
1.119 + NULL,
1.120 + NULL,
1.121 + (int (__cdecl*)(CONST TCHAR *, struct _utimbuf *)) _utime,
1.122 + NULL,
1.123 + NULL,
1.124 + /* getLongPathNameProc */
1.125 + NULL,
1.126 + /* Security SDK - not available on 95,98,ME */
1.127 + NULL, NULL, NULL, NULL, NULL, NULL,
1.128 + /* ReadConsole and WriteConsole */
1.129 + (BOOL (WINAPI *)(HANDLE, LPVOID, DWORD, LPDWORD, LPVOID)) ReadConsoleA,
1.130 + (BOOL (WINAPI *)(HANDLE, const VOID*, DWORD, LPDWORD, LPVOID)) WriteConsoleA
1.131 +};
1.132 +
1.133 +static TclWinProcs unicodeProcs = {
1.134 + 1,
1.135 +
1.136 + (BOOL (WINAPI *)(CONST TCHAR *, LPDCB)) BuildCommDCBW,
1.137 + (TCHAR *(WINAPI *)(TCHAR *)) CharLowerW,
1.138 + (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *, BOOL)) CopyFileW,
1.139 + (BOOL (WINAPI *)(CONST TCHAR *, LPSECURITY_ATTRIBUTES)) CreateDirectoryW,
1.140 + (HANDLE (WINAPI *)(CONST TCHAR *, DWORD, DWORD, SECURITY_ATTRIBUTES *,
1.141 + DWORD, DWORD, HANDLE)) CreateFileW,
1.142 + (BOOL (WINAPI *)(CONST TCHAR *, TCHAR *, LPSECURITY_ATTRIBUTES,
1.143 + LPSECURITY_ATTRIBUTES, BOOL, DWORD, LPVOID, CONST TCHAR *,
1.144 + LPSTARTUPINFOA, LPPROCESS_INFORMATION)) CreateProcessW,
1.145 + (BOOL (WINAPI *)(CONST TCHAR *)) DeleteFileW,
1.146 + (HANDLE (WINAPI *)(CONST TCHAR *, WIN32_FIND_DATAT *)) FindFirstFileW,
1.147 + (BOOL (WINAPI *)(HANDLE, WIN32_FIND_DATAT *)) FindNextFileW,
1.148 + (BOOL (WINAPI *)(WCHAR *, LPDWORD)) GetComputerNameW,
1.149 + (DWORD (WINAPI *)(DWORD, WCHAR *)) GetCurrentDirectoryW,
1.150 + (DWORD (WINAPI *)(CONST TCHAR *)) GetFileAttributesW,
1.151 + (DWORD (WINAPI *)(CONST TCHAR *, DWORD nBufferLength, WCHAR *,
1.152 + TCHAR **)) GetFullPathNameW,
1.153 + (DWORD (WINAPI *)(HMODULE, WCHAR *, int)) GetModuleFileNameW,
1.154 + (DWORD (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD)) GetShortPathNameW,
1.155 + (UINT (WINAPI *)(CONST TCHAR *, CONST TCHAR *, UINT uUnique,
1.156 + WCHAR *)) GetTempFileNameW,
1.157 + (DWORD (WINAPI *)(DWORD, WCHAR *)) GetTempPathW,
1.158 + (BOOL (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD, LPDWORD, LPDWORD, LPDWORD,
1.159 + WCHAR *, DWORD)) GetVolumeInformationW,
1.160 + (HINSTANCE (WINAPI *)(CONST TCHAR *)) LoadLibraryW,
1.161 + (TCHAR (WINAPI *)(WCHAR *, CONST TCHAR *)) lstrcpyW,
1.162 + (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *)) MoveFileW,
1.163 + (BOOL (WINAPI *)(CONST TCHAR *)) RemoveDirectoryW,
1.164 + (DWORD (WINAPI *)(CONST TCHAR *, CONST TCHAR *, CONST TCHAR *, DWORD,
1.165 + WCHAR *, TCHAR **)) SearchPathW,
1.166 + (BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryW,
1.167 + (BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesW,
1.168 + /*
1.169 + * The three NULL function pointers will only be set when
1.170 + * Tcl_FindExecutable is called. If you don't ever call that
1.171 + * function, the application will crash whenever WinTcl tries to call
1.172 + * functions through these null pointers. That is not a bug in Tcl
1.173 + * -- Tcl_FindExecutable is obligatory in recent Tcl releases.
1.174 + */
1.175 + NULL,
1.176 + NULL,
1.177 + (int (__cdecl*)(CONST TCHAR *, struct _utimbuf *)) _wutime,
1.178 + NULL,
1.179 + NULL,
1.180 + /* getLongPathNameProc */
1.181 + NULL,
1.182 + /* Security SDK - will be filled in on NT,XP,2000,2003 */
1.183 + NULL, NULL, NULL, NULL, NULL, NULL,
1.184 + /* ReadConsole and WriteConsole */
1.185 + (BOOL (WINAPI *)(HANDLE, LPVOID, DWORD, LPDWORD, LPVOID)) ReadConsoleW,
1.186 + (BOOL (WINAPI *)(HANDLE, const VOID*, DWORD, LPDWORD, LPVOID)) WriteConsoleW
1.187 +};
1.188 +
1.189 +TclWinProcs *tclWinProcs;
1.190 +static Tcl_Encoding tclWinTCharEncoding;
1.191 +
1.192 +
1.193 +#ifdef HAVE_NO_SEH
1.194 +
1.195 +/* Need to add noinline flag to DllMain declaration so that gcc -O3
1.196 + * does not inline asm code into DllEntryPoint and cause a
1.197 + * compile time error because of redefined local labels.
1.198 + */
1.199 +
1.200 +BOOL APIENTRY DllMain(HINSTANCE hInst, DWORD reason,
1.201 + LPVOID reserved)
1.202 + __attribute__ ((noinline));
1.203 +
1.204 +#else
1.205 +
1.206 +/*
1.207 + * The following declaration is for the VC++ DLL entry point.
1.208 + */
1.209 +
1.210 +BOOL APIENTRY DllMain(HINSTANCE hInst, DWORD reason,
1.211 + LPVOID reserved);
1.212 +#endif /* HAVE_NO_SEH */
1.213 +
1.214 +
1.215 +/*
1.216 + * The following structure and linked list is to allow us to map between
1.217 + * volume mount points and drive letters on the fly (no Win API exists
1.218 + * for this).
1.219 + */
1.220 +typedef struct MountPointMap {
1.221 + CONST WCHAR* volumeName; /* Native wide string volume name */
1.222 + char driveLetter; /* Drive letter corresponding to
1.223 + * the volume name. */
1.224 + struct MountPointMap* nextPtr; /* Pointer to next structure in list,
1.225 + * or NULL */
1.226 +} MountPointMap;
1.227 +
1.228 +/*
1.229 + * This is the head of the linked list, which is protected by the
1.230 + * mutex which follows, for thread-enabled builds.
1.231 + */
1.232 +MountPointMap *driveLetterLookup = NULL;
1.233 +TCL_DECLARE_MUTEX(mountPointMap)
1.234 +
1.235 +/* We will need this below */
1.236 +extern Tcl_FSDupInternalRepProc TclNativeDupInternalRep;
1.237 +
1.238 +#ifdef __WIN32__
1.239 +#ifndef STATIC_BUILD
1.240 +
1.241 +
1.242 +/*
1.243 + *----------------------------------------------------------------------
1.244 + *
1.245 + * DllEntryPoint --
1.246 + *
1.247 + * This wrapper function is used by Borland to invoke the
1.248 + * initialization code for Tcl. It simply calls the DllMain
1.249 + * routine.
1.250 + *
1.251 + * Results:
1.252 + * See DllMain.
1.253 + *
1.254 + * Side effects:
1.255 + * See DllMain.
1.256 + *
1.257 + *----------------------------------------------------------------------
1.258 + */
1.259 +
1.260 +BOOL APIENTRY
1.261 +DllEntryPoint(hInst, reason, reserved)
1.262 + HINSTANCE hInst; /* Library instance handle. */
1.263 + DWORD reason; /* Reason this function is being called. */
1.264 + LPVOID reserved; /* Not used. */
1.265 +{
1.266 + return DllMain(hInst, reason, reserved);
1.267 +}
1.268 +
1.269 +/*
1.270 + *----------------------------------------------------------------------
1.271 + *
1.272 + * DllMain --
1.273 + *
1.274 + * This routine is called by the VC++ C run time library init
1.275 + * code, or the DllEntryPoint routine. It is responsible for
1.276 + * initializing various dynamically loaded libraries.
1.277 + *
1.278 + * Results:
1.279 + * TRUE on sucess, FALSE on failure.
1.280 + *
1.281 + * Side effects:
1.282 + * Establishes 32-to-16 bit thunk and initializes sockets library.
1.283 + *
1.284 + *----------------------------------------------------------------------
1.285 + */
1.286 +BOOL APIENTRY
1.287 +DllMain(hInst, reason, reserved)
1.288 + HINSTANCE hInst; /* Library instance handle. */
1.289 + DWORD reason; /* Reason this function is being called. */
1.290 + LPVOID reserved; /* Not used. */
1.291 +{
1.292 +#ifdef HAVE_NO_SEH
1.293 + EXCEPTION_REGISTRATION registration;
1.294 +#endif
1.295 +
1.296 + switch (reason) {
1.297 + case DLL_PROCESS_ATTACH:
1.298 + DisableThreadLibraryCalls(hInst);
1.299 + TclWinInit(hInst);
1.300 + return TRUE;
1.301 +
1.302 + case DLL_PROCESS_DETACH:
1.303 + /*
1.304 + * Protect the call to Tcl_Finalize. The OS could be unloading
1.305 + * us from an exception handler and the state of the stack might
1.306 + * be unstable.
1.307 + */
1.308 +#ifdef HAVE_NO_SEH
1.309 + __asm__ __volatile__ (
1.310 +
1.311 + /*
1.312 + * Construct an EXCEPTION_REGISTRATION to protect the
1.313 + * call to Tcl_Finalize
1.314 + */
1.315 + "leal %[registration], %%edx" "\n\t"
1.316 + "movl %%fs:0, %%eax" "\n\t"
1.317 + "movl %%eax, 0x0(%%edx)" "\n\t" /* link */
1.318 + "leal 1f, %%eax" "\n\t"
1.319 + "movl %%eax, 0x4(%%edx)" "\n\t" /* handler */
1.320 + "movl %%ebp, 0x8(%%edx)" "\n\t" /* ebp */
1.321 + "movl %%esp, 0xc(%%edx)" "\n\t" /* esp */
1.322 + "movl %[error], 0x10(%%edx)" "\n\t" /* status */
1.323 +
1.324 + /*
1.325 + * Link the EXCEPTION_REGISTRATION on the chain
1.326 + */
1.327 + "movl %%edx, %%fs:0" "\n\t"
1.328 +
1.329 + /*
1.330 + * Call Tcl_Finalize
1.331 + */
1.332 + "call _Tcl_Finalize" "\n\t"
1.333 +
1.334 + /*
1.335 + * Come here on a normal exit. Recover the EXCEPTION_REGISTRATION
1.336 + * and store a TCL_OK status
1.337 + */
1.338 +
1.339 + "movl %%fs:0, %%edx" "\n\t"
1.340 + "movl %[ok], %%eax" "\n\t"
1.341 + "movl %%eax, 0x10(%%edx)" "\n\t"
1.342 + "jmp 2f" "\n"
1.343 +
1.344 + /*
1.345 + * Come here on an exception. Get the EXCEPTION_REGISTRATION
1.346 + * that we previously put on the chain.
1.347 + */
1.348 +
1.349 + "1:" "\t"
1.350 + "movl %%fs:0, %%edx" "\n\t"
1.351 + "movl 0x8(%%edx), %%edx" "\n"
1.352 +
1.353 +
1.354 + /*
1.355 + * Come here however we exited. Restore context from the
1.356 + * EXCEPTION_REGISTRATION in case the stack is unbalanced.
1.357 + */
1.358 +
1.359 + "2:" "\t"
1.360 + "movl 0xc(%%edx), %%esp" "\n\t"
1.361 + "movl 0x8(%%edx), %%ebp" "\n\t"
1.362 + "movl 0x0(%%edx), %%eax" "\n\t"
1.363 + "movl %%eax, %%fs:0" "\n\t"
1.364 +
1.365 + :
1.366 + /* No outputs */
1.367 + :
1.368 + [registration] "m" (registration),
1.369 + [ok] "i" (TCL_OK),
1.370 + [error] "i" (TCL_ERROR)
1.371 + :
1.372 + "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory"
1.373 + );
1.374 +
1.375 +#else /* HAVE_NO_SEH */
1.376 + __try {
1.377 + Tcl_Finalize();
1.378 + } __except (EXCEPTION_EXECUTE_HANDLER) {
1.379 + /* empty handler body. */
1.380 + }
1.381 +#endif
1.382 +
1.383 + break;
1.384 + }
1.385 +
1.386 + return TRUE;
1.387 +}
1.388 +
1.389 +#endif /* !STATIC_BUILD */
1.390 +#endif /* __WIN32__ */
1.391 +
1.392 +/*
1.393 + *----------------------------------------------------------------------
1.394 + *
1.395 + * TclWinGetTclInstance --
1.396 + *
1.397 + * Retrieves the global library instance handle.
1.398 + *
1.399 + * Results:
1.400 + * Returns the global library instance handle.
1.401 + *
1.402 + * Side effects:
1.403 + * None.
1.404 + *
1.405 + *----------------------------------------------------------------------
1.406 + */
1.407 +
1.408 +HINSTANCE
1.409 +TclWinGetTclInstance()
1.410 +{
1.411 + return hInstance;
1.412 +}
1.413 +
1.414 +/*
1.415 + *----------------------------------------------------------------------
1.416 + *
1.417 + * TclWinInit --
1.418 + *
1.419 + * This function initializes the internal state of the tcl library.
1.420 + *
1.421 + * Results:
1.422 + * None.
1.423 + *
1.424 + * Side effects:
1.425 + * Initializes the tclPlatformId variable.
1.426 + *
1.427 + *----------------------------------------------------------------------
1.428 + */
1.429 +
1.430 +void
1.431 +TclWinInit(hInst)
1.432 + HINSTANCE hInst; /* Library instance handle. */
1.433 +{
1.434 + OSVERSIONINFO os;
1.435 +
1.436 + hInstance = hInst;
1.437 + os.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
1.438 + GetVersionEx(&os);
1.439 + platformId = os.dwPlatformId;
1.440 +
1.441 + /*
1.442 + * We no longer support Win32s, so just in case someone manages to
1.443 + * get a runtime there, make sure they know that.
1.444 + */
1.445 +
1.446 + if (platformId == VER_PLATFORM_WIN32s) {
1.447 + panic("Win32s is not a supported platform");
1.448 + }
1.449 +
1.450 + tclWinProcs = &asciiProcs;
1.451 +}
1.452 +
1.453 +/*
1.454 + *----------------------------------------------------------------------
1.455 + *
1.456 + * TclWinGetPlatformId --
1.457 + *
1.458 + * Determines whether running under NT, 95, or Win32s, to allow
1.459 + * runtime conditional code.
1.460 + *
1.461 + * Results:
1.462 + * The return value is one of:
1.463 + * VER_PLATFORM_WIN32s Win32s on Windows 3.1. (not supported)
1.464 + * VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 95.
1.465 + * VER_PLATFORM_WIN32_NT Win32 on Windows NT
1.466 + *
1.467 + * Side effects:
1.468 + * None.
1.469 + *
1.470 + *----------------------------------------------------------------------
1.471 + */
1.472 +
1.473 +int
1.474 +TclWinGetPlatformId()
1.475 +{
1.476 + return platformId;
1.477 +}
1.478 +
1.479 +/*
1.480 + *-------------------------------------------------------------------------
1.481 + *
1.482 + * TclWinNoBackslash --
1.483 + *
1.484 + * We're always iterating through a string in Windows, changing the
1.485 + * backslashes to slashes for use in Tcl.
1.486 + *
1.487 + * Results:
1.488 + * All backslashes in given string are changed to slashes.
1.489 + *
1.490 + * Side effects:
1.491 + * None.
1.492 + *
1.493 + *-------------------------------------------------------------------------
1.494 + */
1.495 +
1.496 +char *
1.497 +TclWinNoBackslash(
1.498 + char *path) /* String to change. */
1.499 +{
1.500 + char *p;
1.501 +
1.502 + for (p = path; *p != '\0'; p++) {
1.503 + if (*p == '\\') {
1.504 + *p = '/';
1.505 + }
1.506 + }
1.507 + return path;
1.508 +}
1.509 +
1.510 +/*
1.511 + *----------------------------------------------------------------------
1.512 + *
1.513 + * TclpCheckStackSpace --
1.514 + *
1.515 + * Detect if we are about to blow the stack. Called before an
1.516 + * evaluation can happen when nesting depth is checked.
1.517 + *
1.518 + * Results:
1.519 + * 1 if there is enough stack space to continue; 0 if not.
1.520 + *
1.521 + * Side effects:
1.522 + * None.
1.523 + *
1.524 + *----------------------------------------------------------------------
1.525 + */
1.526 +
1.527 +int
1.528 +TclpCheckStackSpace()
1.529 +{
1.530 +
1.531 +#ifdef HAVE_NO_SEH
1.532 + EXCEPTION_REGISTRATION registration;
1.533 +#endif
1.534 + int retval = 0;
1.535 +
1.536 + /*
1.537 + * We can recurse only if there is at least TCL_WIN_STACK_THRESHOLD
1.538 + * bytes of stack space left. alloca() is cheap on windows; basically
1.539 + * it just subtracts from the stack pointer causing the OS to throw an
1.540 + * exception if the stack pointer is set below the bottom of the stack.
1.541 + */
1.542 +
1.543 +#ifdef HAVE_NO_SEH
1.544 + __asm__ __volatile__ (
1.545 +
1.546 + /*
1.547 + * Construct an EXCEPTION_REGISTRATION to protect the
1.548 + * call to __alloca
1.549 + */
1.550 + "leal %[registration], %%edx" "\n\t"
1.551 + "movl %%fs:0, %%eax" "\n\t"
1.552 + "movl %%eax, 0x0(%%edx)" "\n\t" /* link */
1.553 + "leal 1f, %%eax" "\n\t"
1.554 + "movl %%eax, 0x4(%%edx)" "\n\t" /* handler */
1.555 + "movl %%ebp, 0x8(%%edx)" "\n\t" /* ebp */
1.556 + "movl %%esp, 0xc(%%edx)" "\n\t" /* esp */
1.557 + "movl %[error], 0x10(%%edx)" "\n\t" /* status */
1.558 +
1.559 + /*
1.560 + * Link the EXCEPTION_REGISTRATION on the chain
1.561 + */
1.562 + "movl %%edx, %%fs:0" "\n\t"
1.563 +
1.564 + /*
1.565 + * Attempt a call to __alloca, to determine whether there's
1.566 + * sufficient memory to be had.
1.567 + */
1.568 +
1.569 + "movl %[size], %%eax" "\n\t"
1.570 + "pushl %%eax" "\n\t"
1.571 + "call __alloca" "\n\t"
1.572 +
1.573 + /*
1.574 + * Come here on a normal exit. Recover the EXCEPTION_REGISTRATION
1.575 + * and store a TCL_OK status
1.576 + */
1.577 + "movl %%fs:0, %%edx" "\n\t"
1.578 + "movl %[ok], %%eax" "\n\t"
1.579 + "movl %%eax, 0x10(%%edx)" "\n\t"
1.580 + "jmp 2f" "\n"
1.581 +
1.582 + /*
1.583 + * Come here on an exception. Get the EXCEPTION_REGISTRATION
1.584 + * that we previously put on the chain.
1.585 + */
1.586 + "1:" "\t"
1.587 + "movl %%fs:0, %%edx" "\n\t"
1.588 + "movl 0x8(%%edx), %%edx" "\n\t"
1.589 +
1.590 + /*
1.591 + * Come here however we exited. Restore context from the
1.592 + * EXCEPTION_REGISTRATION in case the stack is unbalanced.
1.593 + */
1.594 +
1.595 + "2:" "\t"
1.596 + "movl 0xc(%%edx), %%esp" "\n\t"
1.597 + "movl 0x8(%%edx), %%ebp" "\n\t"
1.598 + "movl 0x0(%%edx), %%eax" "\n\t"
1.599 + "movl %%eax, %%fs:0" "\n\t"
1.600 +
1.601 + :
1.602 + /* No outputs */
1.603 + :
1.604 + [registration] "m" (registration),
1.605 + [ok] "i" (TCL_OK),
1.606 + [error] "i" (TCL_ERROR),
1.607 + [size] "i" (TCL_WIN_STACK_THRESHOLD)
1.608 + :
1.609 + "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory"
1.610 + );
1.611 + retval = (registration.status == TCL_OK);
1.612 +
1.613 +#else /* !HAVE_NO_SEH */
1.614 + __try {
1.615 +#ifdef HAVE_ALLOCA_GCC_INLINE
1.616 + __asm__ __volatile__ (
1.617 + "movl %0, %%eax" "\n\t"
1.618 + "call __alloca" "\n\t"
1.619 + :
1.620 + : "i"(TCL_WIN_STACK_THRESHOLD)
1.621 + : "%eax");
1.622 +#else
1.623 + alloca(TCL_WIN_STACK_THRESHOLD);
1.624 +#endif /* HAVE_ALLOCA_GCC_INLINE */
1.625 + retval = 1;
1.626 + } __except (EXCEPTION_EXECUTE_HANDLER) {}
1.627 +#endif /* HAVE_NO_SEH */
1.628 +
1.629 + return retval;
1.630 +}
1.631 +
1.632 +/*
1.633 + *----------------------------------------------------------------------
1.634 + *
1.635 + * TclWinGetPlatform --
1.636 + *
1.637 + * This is a kludge that allows the test library to get access
1.638 + * the internal tclPlatform variable.
1.639 + *
1.640 + * Results:
1.641 + * Returns a pointer to the tclPlatform variable.
1.642 + *
1.643 + * Side effects:
1.644 + * None.
1.645 + *
1.646 + *----------------------------------------------------------------------
1.647 + */
1.648 +
1.649 +TclPlatformType *
1.650 +TclWinGetPlatform()
1.651 +{
1.652 + return &tclPlatform;
1.653 +}
1.654 +
1.655 +/*
1.656 + *---------------------------------------------------------------------------
1.657 + *
1.658 + * TclWinSetInterfaces --
1.659 + *
1.660 + * A helper proc that allows the test library to change the
1.661 + * tclWinProcs structure to dispatch to either the wide-character
1.662 + * or multi-byte versions of the operating system calls, depending
1.663 + * on whether Unicode is the system encoding.
1.664 + *
1.665 + * As well as this, we can also try to load in some additional
1.666 + * procs which may/may not be present depending on the current
1.667 + * Windows version (e.g. Win95 will not have the procs below).
1.668 + *
1.669 + * Results:
1.670 + * None.
1.671 + *
1.672 + * Side effects:
1.673 + * None.
1.674 + *
1.675 + *---------------------------------------------------------------------------
1.676 + */
1.677 +
1.678 +void
1.679 +TclWinSetInterfaces(
1.680 + int wide) /* Non-zero to use wide interfaces, 0
1.681 + * otherwise. */
1.682 +{
1.683 + Tcl_FreeEncoding(tclWinTCharEncoding);
1.684 +
1.685 + if (wide) {
1.686 + tclWinProcs = &unicodeProcs;
1.687 + tclWinTCharEncoding = Tcl_GetEncoding(NULL, "unicode");
1.688 + if (tclWinProcs->getFileAttributesExProc == NULL) {
1.689 + HINSTANCE hInstance = LoadLibraryA("kernel32");
1.690 + if (hInstance != NULL) {
1.691 + tclWinProcs->getFileAttributesExProc =
1.692 + (BOOL (WINAPI *)(CONST TCHAR *, GET_FILEEX_INFO_LEVELS,
1.693 + LPVOID)) GetProcAddress(hInstance, "GetFileAttributesExW");
1.694 + tclWinProcs->createHardLinkProc =
1.695 + (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR*,
1.696 + LPSECURITY_ATTRIBUTES)) GetProcAddress(hInstance,
1.697 + "CreateHardLinkW");
1.698 + tclWinProcs->findFirstFileExProc =
1.699 + (HANDLE (WINAPI *)(CONST TCHAR*, UINT,
1.700 + LPVOID, UINT, LPVOID, DWORD)) GetProcAddress(hInstance,
1.701 + "FindFirstFileExW");
1.702 + tclWinProcs->getVolumeNameForVMPProc =
1.703 + (BOOL (WINAPI *)(CONST TCHAR*, TCHAR*,
1.704 + DWORD)) GetProcAddress(hInstance,
1.705 + "GetVolumeNameForVolumeMountPointW");
1.706 + FreeLibrary(hInstance);
1.707 + }
1.708 + hInstance = LoadLibraryA("advapi32");
1.709 + if (hInstance != NULL) {
1.710 + tclWinProcs->getFileSecurityProc = (BOOL (WINAPI *)(
1.711 + LPCTSTR lpFileName,
1.712 + SECURITY_INFORMATION RequestedInformation,
1.713 + PSECURITY_DESCRIPTOR pSecurityDescriptor,
1.714 + DWORD nLength, LPDWORD lpnLengthNeeded))
1.715 + GetProcAddress(hInstance, "GetFileSecurityW");
1.716 + tclWinProcs->impersonateSelfProc = (BOOL (WINAPI *) (
1.717 + SECURITY_IMPERSONATION_LEVEL ImpersonationLevel))
1.718 + GetProcAddress(hInstance, "ImpersonateSelf");
1.719 + tclWinProcs->openThreadTokenProc = (BOOL (WINAPI *) (
1.720 + HANDLE ThreadHandle, DWORD DesiredAccess,
1.721 + BOOL OpenAsSelf, PHANDLE TokenHandle))
1.722 + GetProcAddress(hInstance, "OpenThreadToken");
1.723 + tclWinProcs->revertToSelfProc = (BOOL (WINAPI *) (void))
1.724 + GetProcAddress(hInstance, "RevertToSelf");
1.725 + tclWinProcs->mapGenericMaskProc = (VOID (WINAPI *) (
1.726 + PDWORD AccessMask, PGENERIC_MAPPING GenericMapping))
1.727 + GetProcAddress(hInstance, "MapGenericMask");
1.728 + tclWinProcs->accessCheckProc = (BOOL (WINAPI *)(
1.729 + PSECURITY_DESCRIPTOR pSecurityDescriptor,
1.730 + HANDLE ClientToken, DWORD DesiredAccess,
1.731 + PGENERIC_MAPPING GenericMapping,
1.732 + PPRIVILEGE_SET PrivilegeSet,
1.733 + LPDWORD PrivilegeSetLength, LPDWORD GrantedAccess,
1.734 + LPBOOL AccessStatus)) GetProcAddress(hInstance,
1.735 + "AccessCheck");
1.736 + FreeLibrary(hInstance);
1.737 + }
1.738 + }
1.739 + } else {
1.740 + tclWinProcs = &asciiProcs;
1.741 + tclWinTCharEncoding = NULL;
1.742 + if (tclWinProcs->getFileAttributesExProc == NULL) {
1.743 + HINSTANCE hInstance = LoadLibraryA("kernel32");
1.744 + if (hInstance != NULL) {
1.745 + tclWinProcs->getFileAttributesExProc =
1.746 + (BOOL (WINAPI *)(CONST TCHAR *, GET_FILEEX_INFO_LEVELS,
1.747 + LPVOID)) GetProcAddress(hInstance, "GetFileAttributesExA");
1.748 + tclWinProcs->createHardLinkProc =
1.749 + (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR*,
1.750 + LPSECURITY_ATTRIBUTES)) GetProcAddress(hInstance,
1.751 + "CreateHardLinkA");
1.752 + tclWinProcs->findFirstFileExProc =
1.753 + (HANDLE (WINAPI *)(CONST TCHAR*, UINT,
1.754 + LPVOID, UINT, LPVOID, DWORD)) GetProcAddress(hInstance,
1.755 + "FindFirstFileExA");
1.756 + tclWinProcs->getLongPathNameProc = NULL;
1.757 + tclWinProcs->getVolumeNameForVMPProc =
1.758 + (BOOL (WINAPI *)(CONST TCHAR*, TCHAR*,
1.759 + DWORD)) GetProcAddress(hInstance,
1.760 + "GetVolumeNameForVolumeMountPointA");
1.761 + FreeLibrary(hInstance);
1.762 + }
1.763 + }
1.764 + }
1.765 +}
1.766 +
1.767 +/*
1.768 + *---------------------------------------------------------------------------
1.769 + *
1.770 + * TclWinResetInterfaceEncodings --
1.771 + *
1.772 + * Called during finalization to free up any encodings we use.
1.773 + * The tclWinProcs-> look up table is still ok to use after
1.774 + * this call, provided no encoding conversion is required.
1.775 + *
1.776 + * We also clean up any memory allocated in our mount point
1.777 + * map which is used to follow certain kinds of symlinks.
1.778 + * That code should never be used once encodings are taken
1.779 + * down.
1.780 + *
1.781 + * Results:
1.782 + * None.
1.783 + *
1.784 + * Side effects:
1.785 + * None.
1.786 + *
1.787 + *---------------------------------------------------------------------------
1.788 + */
1.789 +void
1.790 +TclWinResetInterfaceEncodings()
1.791 +{
1.792 + MountPointMap *dlIter, *dlIter2;
1.793 + if (tclWinTCharEncoding != NULL) {
1.794 + Tcl_FreeEncoding(tclWinTCharEncoding);
1.795 + tclWinTCharEncoding = NULL;
1.796 + }
1.797 + /* Clean up the mount point map */
1.798 + Tcl_MutexLock(&mountPointMap);
1.799 + dlIter = driveLetterLookup;
1.800 + while (dlIter != NULL) {
1.801 + dlIter2 = dlIter->nextPtr;
1.802 + ckfree((char*)dlIter->volumeName);
1.803 + ckfree((char*)dlIter);
1.804 + dlIter = dlIter2;
1.805 + }
1.806 + Tcl_MutexUnlock(&mountPointMap);
1.807 +}
1.808 +
1.809 +/*
1.810 + *---------------------------------------------------------------------------
1.811 + *
1.812 + * TclWinResetInterfaces --
1.813 + *
1.814 + * Called during finalization to reset us to a safe state for reuse.
1.815 + * After this call, it is best not to use the tclWinProcs-> look
1.816 + * up table since it is likely to be different to what is expected.
1.817 + *
1.818 + * Results:
1.819 + * None.
1.820 + *
1.821 + * Side effects:
1.822 + * None.
1.823 + *
1.824 + *---------------------------------------------------------------------------
1.825 + */
1.826 +void
1.827 +TclWinResetInterfaces()
1.828 +{
1.829 + tclWinProcs = &asciiProcs;
1.830 +}
1.831 +
1.832 +/*
1.833 + *--------------------------------------------------------------------
1.834 + *
1.835 + * TclWinDriveLetterForVolMountPoint
1.836 + *
1.837 + * Unfortunately, Windows provides no easy way at all to get hold
1.838 + * of the drive letter for a volume mount point, but we need that
1.839 + * information to understand paths correctly. So, we have to
1.840 + * build an associated array to find these correctly, and allow
1.841 + * quick and easy lookup from volume mount points to drive letters.
1.842 + *
1.843 + * We assume here that we are running on a system for which the wide
1.844 + * character interfaces are used, which is valid for Win 2000 and WinXP
1.845 + * which are the only systems on which this function will ever be called.
1.846 + *
1.847 + * Result: the drive letter, or -1 if no drive letter corresponds to
1.848 + * the given mount point.
1.849 + *
1.850 + *--------------------------------------------------------------------
1.851 + */
1.852 +char
1.853 +TclWinDriveLetterForVolMountPoint(CONST WCHAR *mountPoint)
1.854 +{
1.855 + MountPointMap *dlIter, *dlPtr2;
1.856 + WCHAR Target[55]; /* Target of mount at mount point */
1.857 + WCHAR drive[4] = { L'A', L':', L'\\', L'\0' };
1.858 +
1.859 + /*
1.860 + * Detect the volume mounted there. Unfortunately, there is no
1.861 + * simple way to map a unique volume name to a DOS drive letter.
1.862 + * So, we have to build an associative array.
1.863 + */
1.864 +
1.865 + Tcl_MutexLock(&mountPointMap);
1.866 + dlIter = driveLetterLookup;
1.867 + while (dlIter != NULL) {
1.868 + if (wcscmp(dlIter->volumeName, mountPoint) == 0) {
1.869 + /*
1.870 + * We need to check whether this information is
1.871 + * still valid, since either the user or various
1.872 + * programs could have adjusted the mount points on
1.873 + * the fly.
1.874 + */
1.875 + drive[0] = L'A' + (dlIter->driveLetter - 'A');
1.876 + /* Try to read the volume mount point and see where it points */
1.877 + if ((*tclWinProcs->getVolumeNameForVMPProc)((TCHAR*)drive,
1.878 + (TCHAR*)Target, 55) != 0) {
1.879 + if (wcscmp((WCHAR*)dlIter->volumeName, Target) == 0) {
1.880 + /* Nothing has changed */
1.881 + Tcl_MutexUnlock(&mountPointMap);
1.882 + return dlIter->driveLetter;
1.883 + }
1.884 + }
1.885 + /*
1.886 + * If we reach here, unfortunately, this mount point is
1.887 + * no longer valid at all
1.888 + */
1.889 + if (driveLetterLookup == dlIter) {
1.890 + dlPtr2 = dlIter;
1.891 + driveLetterLookup = dlIter->nextPtr;
1.892 + } else {
1.893 + for (dlPtr2 = driveLetterLookup;
1.894 + dlPtr2 != NULL; dlPtr2 = dlPtr2->nextPtr) {
1.895 + if (dlPtr2->nextPtr == dlIter) {
1.896 + dlPtr2->nextPtr = dlIter->nextPtr;
1.897 + dlPtr2 = dlIter;
1.898 + break;
1.899 + }
1.900 + }
1.901 + }
1.902 + /* Now dlPtr2 points to the structure to free */
1.903 + ckfree((char*)dlPtr2->volumeName);
1.904 + ckfree((char*)dlPtr2);
1.905 + /*
1.906 + * Restart the loop --- we could try to be clever
1.907 + * and continue half way through, but the logic is a
1.908 + * bit messy, so it's cleanest just to restart
1.909 + */
1.910 + dlIter = driveLetterLookup;
1.911 + continue;
1.912 + }
1.913 + dlIter = dlIter->nextPtr;
1.914 + }
1.915 +
1.916 + /* We couldn't find it, so we must iterate over the letters */
1.917 +
1.918 + for (drive[0] = L'A'; drive[0] <= L'Z'; drive[0]++) {
1.919 + /* Try to read the volume mount point and see where it points */
1.920 + if ((*tclWinProcs->getVolumeNameForVMPProc)((TCHAR*)drive,
1.921 + (TCHAR*)Target, 55) != 0) {
1.922 + int alreadyStored = 0;
1.923 + for (dlIter = driveLetterLookup; dlIter != NULL;
1.924 + dlIter = dlIter->nextPtr) {
1.925 + if (wcscmp((WCHAR*)dlIter->volumeName, Target) == 0) {
1.926 + alreadyStored = 1;
1.927 + break;
1.928 + }
1.929 + }
1.930 + if (!alreadyStored) {
1.931 + dlPtr2 = (MountPointMap*) ckalloc(sizeof(MountPointMap));
1.932 + dlPtr2->volumeName = TclNativeDupInternalRep(Target);
1.933 + dlPtr2->driveLetter = 'A' + (drive[0] - L'A');
1.934 + dlPtr2->nextPtr = driveLetterLookup;
1.935 + driveLetterLookup = dlPtr2;
1.936 + }
1.937 + }
1.938 + }
1.939 + /* Try again */
1.940 + for (dlIter = driveLetterLookup; dlIter != NULL;
1.941 + dlIter = dlIter->nextPtr) {
1.942 + if (wcscmp(dlIter->volumeName, mountPoint) == 0) {
1.943 + Tcl_MutexUnlock(&mountPointMap);
1.944 + return dlIter->driveLetter;
1.945 + }
1.946 + }
1.947 + /*
1.948 + * The volume doesn't appear to correspond to a drive letter -- we
1.949 + * remember that fact and store '-1' so we don't have to look it
1.950 + * up each time.
1.951 + */
1.952 + dlPtr2 = (MountPointMap*) ckalloc(sizeof(MountPointMap));
1.953 + dlPtr2->volumeName = TclNativeDupInternalRep((ClientData)mountPoint);
1.954 + dlPtr2->driveLetter = -1;
1.955 + dlPtr2->nextPtr = driveLetterLookup;
1.956 + driveLetterLookup = dlPtr2;
1.957 + Tcl_MutexUnlock(&mountPointMap);
1.958 + return -1;
1.959 +}
1.960 +
1.961 +/*
1.962 + *---------------------------------------------------------------------------
1.963 + *
1.964 + * Tcl_WinUtfToTChar, Tcl_WinTCharToUtf --
1.965 + *
1.966 + * Convert between UTF-8 and Unicode when running Windows NT or
1.967 + * the current ANSI code page when running Windows 95.
1.968 + *
1.969 + * On Mac, Unix, and Windows 95, all strings exchanged between Tcl
1.970 + * and the OS are "char" oriented. We need only one Tcl_Encoding to
1.971 + * convert between UTF-8 and the system's native encoding. We use
1.972 + * NULL to represent that encoding.
1.973 + *
1.974 + * On NT, some strings exchanged between Tcl and the OS are "char"
1.975 + * oriented, while others are in Unicode. We need two Tcl_Encoding
1.976 + * APIs depending on whether we are targeting a "char" or Unicode
1.977 + * interface.
1.978 + *
1.979 + * Calling Tcl_UtfToExternal() or Tcl_ExternalToUtf() with an
1.980 + * encoding of NULL should always used to convert between UTF-8
1.981 + * and the system's "char" oriented encoding. The following two
1.982 + * functions are used in Windows-specific code to convert between
1.983 + * UTF-8 and Unicode strings (NT) or "char" strings(95). This saves
1.984 + * you the trouble of writing the following type of fragment over and
1.985 + * over:
1.986 + *
1.987 + * if (running NT) {
1.988 + * encoding <- Tcl_GetEncoding("unicode");
1.989 + * nativeBuffer <- UtfToExternal(encoding, utfBuffer);
1.990 + * Tcl_FreeEncoding(encoding);
1.991 + * } else {
1.992 + * nativeBuffer <- UtfToExternal(NULL, utfBuffer);
1.993 + * }
1.994 + *
1.995 + * By convention, in Windows a TCHAR is a character in the ANSI code
1.996 + * page on Windows 95, a Unicode character on Windows NT. If you
1.997 + * plan on targeting a Unicode interfaces when running on NT and a
1.998 + * "char" oriented interface while running on 95, these functions
1.999 + * should be used. If you plan on targetting the same "char"
1.1000 + * oriented function on both 95 and NT, use Tcl_UtfToExternal()
1.1001 + * with an encoding of NULL.
1.1002 + *
1.1003 + * Results:
1.1004 + * The result is a pointer to the string in the desired target
1.1005 + * encoding. Storage for the result string is allocated in
1.1006 + * dsPtr; the caller must call Tcl_DStringFree() when the result
1.1007 + * is no longer needed.
1.1008 + *
1.1009 + * Side effects:
1.1010 + * None.
1.1011 + *
1.1012 + *---------------------------------------------------------------------------
1.1013 + */
1.1014 +
1.1015 +TCHAR *
1.1016 +Tcl_WinUtfToTChar(string, len, dsPtr)
1.1017 + CONST char *string; /* Source string in UTF-8. */
1.1018 + int len; /* Source string length in bytes, or < 0 for
1.1019 + * strlen(). */
1.1020 + Tcl_DString *dsPtr; /* Uninitialized or free DString in which
1.1021 + * the converted string is stored. */
1.1022 +{
1.1023 + return (TCHAR *) Tcl_UtfToExternalDString(tclWinTCharEncoding,
1.1024 + string, len, dsPtr);
1.1025 +}
1.1026 +
1.1027 +char *
1.1028 +Tcl_WinTCharToUtf(string, len, dsPtr)
1.1029 + CONST TCHAR *string; /* Source string in Unicode when running
1.1030 + * NT, ANSI when running 95. */
1.1031 + int len; /* Source string length in bytes, or < 0 for
1.1032 + * platform-specific string length. */
1.1033 + Tcl_DString *dsPtr; /* Uninitialized or free DString in which
1.1034 + * the converted string is stored. */
1.1035 +{
1.1036 + return Tcl_ExternalToUtfDString(tclWinTCharEncoding,
1.1037 + (CONST char *) string, len, dsPtr);
1.1038 +}
1.1039 +
1.1040 +/*
1.1041 + *------------------------------------------------------------------------
1.1042 + *
1.1043 + * TclWinCPUID --
1.1044 + *
1.1045 + * Get CPU ID information on an Intel box under Windows
1.1046 + *
1.1047 + * Results:
1.1048 + * Returns TCL_OK if successful, TCL_ERROR if CPUID is not
1.1049 + * supported or fails.
1.1050 + *
1.1051 + * Side effects:
1.1052 + * If successful, stores EAX, EBX, ECX and EDX registers after
1.1053 + * the CPUID instruction in the four integers designated by 'regsPtr'
1.1054 + *
1.1055 + *----------------------------------------------------------------------
1.1056 + */
1.1057 +
1.1058 +int
1.1059 +TclWinCPUID( unsigned int index, /* Which CPUID value to retrieve */
1.1060 + unsigned int * regsPtr ) /* Registers after the CPUID */
1.1061 +{
1.1062 +
1.1063 +#ifdef HAVE_NO_SEH
1.1064 + EXCEPTION_REGISTRATION registration;
1.1065 +#endif
1.1066 + int status = TCL_ERROR;
1.1067 +
1.1068 +#if defined(__GNUC__) && !defined(_WIN64)
1.1069 +
1.1070 + /*
1.1071 + * Execute the CPUID instruction with the given index, and
1.1072 + * store results off 'regPtr'.
1.1073 + */
1.1074 +
1.1075 + __asm__ __volatile__ (
1.1076 +
1.1077 + /*
1.1078 + * Construct an EXCEPTION_REGISTRATION to protect the
1.1079 + * CPUID instruction (early 486's don't have CPUID)
1.1080 + */
1.1081 + "leal %[registration], %%edx" "\n\t"
1.1082 + "movl %%fs:0, %%eax" "\n\t"
1.1083 + "movl %%eax, 0x0(%%edx)" "\n\t" /* link */
1.1084 + "leal 1f, %%eax" "\n\t"
1.1085 + "movl %%eax, 0x4(%%edx)" "\n\t" /* handler */
1.1086 + "movl %%ebp, 0x8(%%edx)" "\n\t" /* ebp */
1.1087 + "movl %%esp, 0xc(%%edx)" "\n\t" /* esp */
1.1088 + "movl %[error], 0x10(%%edx)" "\n\t" /* status */
1.1089 +
1.1090 + /*
1.1091 + * Link the EXCEPTION_REGISTRATION on the chain
1.1092 + */
1.1093 + "movl %%edx, %%fs:0" "\n\t"
1.1094 +
1.1095 + /*
1.1096 + * Do the CPUID instruction, and save the results in
1.1097 + * the 'regsPtr' area
1.1098 + */
1.1099 +
1.1100 + "movl %[rptr], %%edi" "\n\t"
1.1101 + "movl %[index], %%eax" "\n\t"
1.1102 + "cpuid" "\n\t"
1.1103 + "movl %%eax, 0x0(%%edi)" "\n\t"
1.1104 + "movl %%ebx, 0x4(%%edi)" "\n\t"
1.1105 + "movl %%ecx, 0x8(%%edi)" "\n\t"
1.1106 + "movl %%edx, 0xc(%%edi)" "\n\t"
1.1107 +
1.1108 + /*
1.1109 + * Come here on a normal exit. Recover the EXCEPTION_REGISTRATION
1.1110 + * and store a TCL_OK status
1.1111 + */
1.1112 + "movl %%fs:0, %%edx" "\n\t"
1.1113 + "movl %[ok], %%eax" "\n\t"
1.1114 + "movl %%eax, 0x10(%%edx)" "\n\t"
1.1115 + "jmp 2f" "\n"
1.1116 +
1.1117 + /*
1.1118 + * Come here on an exception. Get the EXCEPTION_REGISTRATION
1.1119 + * that we previously put on the chain.
1.1120 + */
1.1121 + "1:" "\t"
1.1122 + "movl %%fs:0, %%edx" "\n\t"
1.1123 + "movl 0x8(%%edx), %%edx" "\n\t"
1.1124 +
1.1125 + /*
1.1126 + * Come here however we exited. Restore context from the
1.1127 + * EXCEPTION_REGISTRATION in case the stack is unbalanced.
1.1128 + */
1.1129 +
1.1130 + "2:" "\t"
1.1131 + "movl 0xc(%%edx), %%esp" "\n\t"
1.1132 + "movl 0x8(%%edx), %%ebp" "\n\t"
1.1133 + "movl 0x0(%%edx), %%eax" "\n\t"
1.1134 + "movl %%eax, %%fs:0" "\n\t"
1.1135 +
1.1136 + :
1.1137 + /* No outputs */
1.1138 + :
1.1139 + [index] "m" (index),
1.1140 + [rptr] "m" (regsPtr),
1.1141 + [registration] "m" (registration),
1.1142 + [ok] "i" (TCL_OK),
1.1143 + [error] "i" (TCL_ERROR)
1.1144 + :
1.1145 + "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory" );
1.1146 + status = registration.status;
1.1147 +
1.1148 +#elif defined(_MSC_VER) && !defined(_WIN64)
1.1149 +
1.1150 + /* Define a structure in the stack frame to hold the registers */
1.1151 +
1.1152 + struct {
1.1153 + DWORD dw0;
1.1154 + DWORD dw1;
1.1155 + DWORD dw2;
1.1156 + DWORD dw3;
1.1157 + } regs;
1.1158 + regs.dw0 = index;
1.1159 +
1.1160 + /* Execute the CPUID instruction and save regs in the stack frame */
1.1161 +
1.1162 + _try {
1.1163 + _asm {
1.1164 + push ebx
1.1165 + push ecx
1.1166 + push edx
1.1167 + mov eax, regs.dw0
1.1168 + cpuid
1.1169 + mov regs.dw0, eax
1.1170 + mov regs.dw1, ebx
1.1171 + mov regs.dw2, ecx
1.1172 + mov regs.dw3, edx
1.1173 + pop edx
1.1174 + pop ecx
1.1175 + pop ebx
1.1176 + }
1.1177 +
1.1178 + /* Copy regs back out to the caller */
1.1179 +
1.1180 + regsPtr[0]=regs.dw0;
1.1181 + regsPtr[1]=regs.dw1;
1.1182 + regsPtr[2]=regs.dw2;
1.1183 + regsPtr[3]=regs.dw3;
1.1184 +
1.1185 + status = TCL_OK;
1.1186 + } __except( EXCEPTION_EXECUTE_HANDLER ) {
1.1187 + }
1.1188 +
1.1189 +#else
1.1190 + /* Don't know how to do assembly code for
1.1191 + * this compiler and/or architecture */
1.1192 +#endif
1.1193 + return status;
1.1194 +}