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 | */ |
---|
22 | typedef struct ThreadSpecificData { |
---|
23 | int *stackBound; /* The current stack boundary */ |
---|
24 | } ThreadSpecificData; |
---|
25 | static 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 | |
---|
33 | typedef DWORD (WINAPI UT32PROC)(LPVOID lpBuff, DWORD dwUserDefined, |
---|
34 | LPVOID *lpTranslationList); |
---|
35 | |
---|
36 | typedef BOOL (WINAPI UTREGISTER)(HANDLE hModule, LPCSTR SixteenBitDLL, |
---|
37 | LPCSTR InitName, LPCSTR ProcName, UT32PROC **ThirtyTwoBitThunk, |
---|
38 | FARPROC UT32Callback, LPVOID Buff); |
---|
39 | |
---|
40 | typedef 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 | |
---|
48 | static HINSTANCE hInstance; /* HINSTANCE of this DLL. */ |
---|
49 | static 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 | |
---|
58 | typedef 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 | |
---|
82 | static 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 | |
---|
140 | static 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 | |
---|
198 | TclWinProcs *tclWinProcs; |
---|
199 | static 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 | |
---|
208 | BOOL 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 | |
---|
215 | BOOL 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 | |
---|
225 | typedef 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 | |
---|
239 | MountPointMap *driveLetterLookup = NULL; |
---|
240 | TCL_DECLARE_MUTEX(mountPointMap) |
---|
241 | |
---|
242 | /* |
---|
243 | * We will need this below. |
---|
244 | */ |
---|
245 | |
---|
246 | extern 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 | |
---|
268 | BOOL APIENTRY |
---|
269 | DllEntryPoint( |
---|
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 | |
---|
298 | BOOL APIENTRY |
---|
299 | DllMain( |
---|
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 | |
---|
422 | HINSTANCE |
---|
423 | TclWinGetTclInstance(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 | |
---|
444 | void |
---|
445 | TclWinInit( |
---|
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 | |
---|
487 | int |
---|
488 | TclWinGetPlatformId(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 | |
---|
510 | char * |
---|
511 | TclWinNoBackslash( |
---|
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 |
---|
545 | int |
---|
546 | TclpGetCStackParams( |
---|
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 | |
---|
624 | void |
---|
625 | TclWinSetInterfaces( |
---|
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 | |
---|
748 | void |
---|
749 | TclWinResetInterfaceEncodings(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 | */ |
---|
789 | void |
---|
790 | TclWinResetInterfaces(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 | |
---|
817 | char |
---|
818 | TclWinDriveLetterForVolMountPoint( |
---|
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 | |
---|
1003 | TCHAR * |
---|
1004 | Tcl_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 | |
---|
1015 | char * |
---|
1016 | Tcl_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 | |
---|
1046 | int |
---|
1047 | TclWinCPUID( |
---|
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 | */ |
---|