/[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 25 - (hide annotations) (download)
Sat Oct 8 06:43:03 2016 UTC (7 years, 8 months ago) by dashley
Original Path: sf_code/esrgpcpj/shared/tcl_base/tclwin32dll.c
File MIME type: text/plain
File size: 15588 byte(s)
Initial commit.
1 dashley 25 /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tclwin32dll.c,v 1.1.1.1 2001/06/13 04:48:12 dtashley Exp $ */
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 */

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25