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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

Properties

Name Value
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25