/[dtapublic]/projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclwin32dll.c
ViewVC logotype

Contents of /projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclwin32dll.c

Parent Directory Parent Directory | Revision Log Revision Log


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

Properties

Name Value
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25