better implementation of change#3326; open(local $foo,...) now
[p5sagit/p5-mst-13.2.git] / win32 / win32.h
1 /* WIN32.H
2  *
3  * (c) 1995 Microsoft Corporation. All rights reserved. 
4  *              Developed by hip communications inc., http://info.hip.com/info/
5  *
6  *    You may distribute under the terms of either the GNU General Public
7  *    License or the Artistic License, as specified in the README file.
8  */
9 #ifndef  _INC_WIN32_PERL5
10 #define  _INC_WIN32_PERL5
11
12 #define _WIN32_WINNT 0x0400     /* needed for TryEnterCriticalSection() etc. */
13
14 #if defined(PERL_OBJECT) || defined(PERL_IMPLICIT_SYS) || defined(PERL_CAPI)
15 #  define DYNAMIC_ENV_FETCH
16 #  define ENV_HV_NAME "___ENV_HV_NAME___"
17 #  define HAS_GETENV_LEN
18 #  define prime_env_iter()
19 #  define WIN32IO_IS_STDIO              /* don't pull in custom stdio layer */
20 #  define WIN32SCK_IS_STDSCK            /* don't pull in custom wsock layer */
21 #  ifdef PERL_GLOBAL_STRUCT
22 #    error PERL_GLOBAL_STRUCT cannot be defined with PERL_IMPLICIT_SYS
23 #  endif
24 #  define win32_get_privlib PerlEnv_lib_path
25 #  define win32_get_sitelib PerlEnv_sitelib_path
26 #endif
27
28 #if defined(PERL_IMPLICIT_CONTEXT)
29 #  define PERL_GET_INTERP       ((PerlInterpreter*)GetPerlInterpreter())
30 #  define PERL_SET_INTERP(i)    (SetPerlInterpreter(i))
31 #endif
32
33 #ifdef __GNUC__
34 #  ifndef __int64               /* some versions seem to #define it already */
35 #    define __int64 long long
36 #  endif
37 #  define Win32_Winsock
38 /* GCC does not do __declspec() - render it a nop 
39  * and turn on options to avoid importing data 
40  */
41 #ifndef __declspec
42 #  define __declspec(x)
43 #endif
44 #  ifndef PERL_OBJECT
45 #    define PERL_GLOBAL_STRUCT
46 #    ifndef MULTIPLICITY
47 #      define MULTIPLICITY
48 #    endif
49 #  endif
50 #endif
51
52 /* Define DllExport akin to perl's EXT, 
53  * If we are in the DLL or mimicing the DLL for Win95 work round
54  * then Export the symbol, 
55  * otherwise import it.
56  */
57
58 #if defined(PERL_OBJECT)
59 #define DllExport
60 #else
61 #if defined(PERLDLL) || defined(WIN95FIX)
62 #define DllExport
63 /*#define DllExport __declspec(dllexport)*/     /* noises with VC5+sp3 */
64 #else 
65 #define DllExport __declspec(dllimport)
66 #endif
67 #endif
68
69 #define  WIN32_LEAN_AND_MEAN
70 #include <windows.h>
71
72 #ifdef   WIN32_LEAN_AND_MEAN            /* C file is NOT a Perl5 original. */
73 #define  CONTEXT        PERL_CONTEXT    /* Avoid conflict of CONTEXT defs. */
74 #endif /*WIN32_LEAN_AND_MEAN */
75
76 #ifndef TLS_OUT_OF_INDEXES
77 #define TLS_OUT_OF_INDEXES (DWORD)0xFFFFFFFF
78 #endif
79
80 #include <dirent.h>
81 #include <io.h>
82 #include <process.h>
83 #include <stdio.h>
84 #include <direct.h>
85 #include <stdlib.h>
86 #ifndef EXT
87 #include "EXTERN.h"
88 #endif
89
90 struct tms {
91         long    tms_utime;
92         long    tms_stime;
93         long    tms_cutime;
94         long    tms_cstime;
95 };
96
97 #ifndef SYS_NMLN
98 #define SYS_NMLN        257
99 #endif
100
101 struct utsname {
102     char sysname[SYS_NMLN];
103     char nodename[SYS_NMLN];
104     char release[SYS_NMLN];
105     char version[SYS_NMLN];
106     char machine[SYS_NMLN];
107 };
108
109 #ifndef START_EXTERN_C
110 #undef EXTERN_C
111 #ifdef __cplusplus
112 #  define START_EXTERN_C extern "C" {
113 #  define END_EXTERN_C }
114 #  define EXTERN_C extern "C"
115 #else
116 #  define START_EXTERN_C 
117 #  define END_EXTERN_C 
118 #  define EXTERN_C
119 #endif
120 #endif
121
122 #define  STANDARD_C     1
123 #define  DOSISH         1               /* no escaping our roots */
124 #define  OP_BINARY      O_BINARY        /* mistake in in pp_sys.c? */
125
126 /* Define USE_SOCKETS_AS_HANDLES to enable emulation of windows sockets as
127  * real filehandles. XXX Should always be defined (the other version is untested) */
128 #define USE_SOCKETS_AS_HANDLES
129
130 /* read() and write() aren't transparent for socket handles */
131 #define PERL_SOCK_SYSREAD_IS_RECV
132 #define PERL_SOCK_SYSWRITE_IS_SEND
133
134
135 /* if USE_WIN32_RTL_ENV is not defined, Perl uses direct Win32 calls
136  * to read the environment, bypassing the runtime's (usually broken)
137  * facilities for accessing the same.  See note in util.c/my_setenv(). */
138 /*#define USE_WIN32_RTL_ENV */
139
140 /* Define USE_FIXED_OSFHANDLE to fix VC's _open_osfhandle() on W95.
141  * Can only enable it if not using the DLL CRT (it doesn't expose internals) */
142 #if defined(_MSC_VER) && !defined(_DLL) && defined(_M_IX86)
143 #define USE_FIXED_OSFHANDLE
144 #endif
145
146 #define ENV_IS_CASELESS
147
148 #ifndef VER_PLATFORM_WIN32_WINDOWS      /* VC-2.0 headers don't have this */
149 #define VER_PLATFORM_WIN32_WINDOWS      1
150 #endif
151
152 #ifndef FILE_SHARE_DELETE               /* VC-4.0 headers don't have this */
153 #define FILE_SHARE_DELETE               0x00000004
154 #endif
155
156 /* access() mode bits */
157 #ifndef R_OK
158 #  define       R_OK    4
159 #  define       W_OK    2
160 #  define       X_OK    1
161 #  define       F_OK    0
162 #endif
163
164 /* Compiler-specific stuff. */
165
166 #ifdef __BORLANDC__             /* Borland C++ */
167
168 #define _access access
169 #define _chdir chdir
170 #include <sys/types.h>
171
172 #ifndef DllMain
173 #define DllMain DllEntryPoint
174 #endif
175
176 #pragma warn -ccc       /* "condition is always true/false" */
177 #pragma warn -rch       /* "unreachable code" */
178 #pragma warn -sig       /* "conversion may lose significant digits" */
179 #pragma warn -pia       /* "possibly incorrect assignment" */
180 #pragma warn -par       /* "parameter 'foo' is never used" */
181 #pragma warn -aus       /* "'foo' is assigned a value that is never used" */
182 #pragma warn -use       /* "'foo' is declared but never used" */
183 #pragma warn -csu       /* "comparing signed and unsigned values" */
184 #pragma warn -pro       /* "call to function with no prototype" */
185 #pragma warn -stu       /* "undefined structure 'foo'" */
186
187 /* Borland is picky about a bare member function name used as its ptr */
188 #ifdef PERL_OBJECT
189 #  define MEMBER_TO_FPTR(name)  &(name)
190 #endif
191
192 #endif
193
194 #ifdef _MSC_VER                 /* Microsoft Visual C++ */
195
196 typedef long            uid_t;
197 typedef long            gid_t;
198 typedef unsigned short  mode_t;
199 #pragma  warning(disable: 4018 4035 4101 4102 4244 4245 4761)
200
201 #ifndef PERL_OBJECT
202
203 /* Visual C thinks that a pointer to a member variable is 16 bytes in size. */
204 #define STRUCT_MGVTBL_DEFINITION                                        \
205 struct mgvtbl {                                                         \
206     union {                                                             \
207         int         (CPERLscope(*svt_get))(pTHX_ SV *sv, MAGIC* mg);    \
208         char        handle_VC_problem1[16];                             \
209     };                                                                  \
210     union {                                                             \
211         int         (CPERLscope(*svt_set))(pTHX_ SV *sv, MAGIC* mg);    \
212         char        handle_VC_problem2[16];                             \
213     };                                                                  \
214     union {                                                             \
215         U32         (CPERLscope(*svt_len))(pTHX_ SV *sv, MAGIC* mg);    \
216         char        handle_VC_problem3[16];                             \
217     };                                                                  \
218     union {                                                             \
219         int         (CPERLscope(*svt_clear))(pTHX_ SV *sv, MAGIC* mg);  \
220         char        handle_VC_problem4[16];                             \
221     };                                                                  \
222     union {                                                             \
223         int         (CPERLscope(*svt_free))(pTHX_ SV *sv, MAGIC* mg);   \
224         char        handle_VC_problem5[16];                             \
225     };                                                                  \
226 }
227
228 #define BASEOP_DEFINITION               \
229     OP*         op_next;                \
230     OP*         op_sibling;             \
231     OP*         (CPERLscope(*op_ppaddr))(pTHX);         \
232     char        handle_VC_problem[12];  \
233     PADOFFSET   op_targ;                \
234     OPCODE      op_type;                \
235     U16         op_seq;                 \
236     U8          op_flags;               \
237     U8          op_private;
238
239 #endif /* PERL_OBJECT */
240
241 #endif /* _MSC_VER */
242
243 #ifdef __MINGW32__              /* Minimal Gnu-Win32 */
244
245 typedef long            uid_t;
246 typedef long            gid_t;
247 #ifndef _environ
248 #define _environ        environ
249 #endif
250 #define flushall        _flushall
251 #define fcloseall       _fcloseall
252
253 #undef __attribute__
254 #define __attribute__(x)
255
256 #ifndef CP_UTF8
257 #  define CP_UTF8       65001
258 #endif
259
260 #ifdef PERL_OBJECT
261 #  define MEMBER_TO_FPTR(name)  &(name)
262 #endif
263
264 #ifndef _O_NOINHERIT
265 #  define _O_NOINHERIT  0x0080
266 #  ifndef _NO_OLDNAMES
267 #    define O_NOINHERIT _O_NOINHERIT
268 #  endif
269 #endif
270
271 #ifndef _O_NOINHERIT
272 #  define _O_NOINHERIT  0x0080
273 #  ifndef _NO_OLDNAMES
274 #    define O_NOINHERIT _O_NOINHERIT
275 #  endif
276 #endif
277
278 #endif /* __MINGW32__ */
279
280 /* compatibility stuff for other compilers goes here */
281
282
283 START_EXTERN_C
284
285 /* For UNIX compatibility. */
286
287 extern  uid_t   getuid(void);
288 extern  gid_t   getgid(void);
289 extern  uid_t   geteuid(void);
290 extern  gid_t   getegid(void);
291 extern  int     setuid(uid_t uid);
292 extern  int     setgid(gid_t gid);
293 extern  int     kill(int pid, int sig);
294 extern  void    *sbrk(int need);
295 extern  char *  getlogin(void);
296 extern  int     chown(const char *p, uid_t o, gid_t g);
297
298 #undef   Stat
299 #define  Stat           win32_stat
300
301 #undef   init_os_extras
302 #define  init_os_extras Perl_init_os_extras
303
304 DllExport void          Perl_win32_init(int *argcp, char ***argvp);
305 DllExport void          Perl_init_os_extras();
306 DllExport void          win32_str_os_error(void *sv, DWORD err);
307 DllExport int           RunPerl(int argc, char **argv, char **env);
308 DllExport bool          SetPerlInterpreter(void* interp);
309 DllExport void*         GetPerlInterpreter(void);
310
311 #ifndef USE_SOCKETS_AS_HANDLES
312 extern FILE *           my_fdopen(int, char *);
313 #endif
314 extern int              my_fclose(FILE *);
315 extern int              do_aspawn(void *really, void **mark, void **sp);
316 extern int              do_spawn(char *cmd);
317 extern int              do_spawn_nowait(char *cmd);
318 extern char *           win32_get_privlib(char *pl);
319 extern char *           win32_get_sitelib(char *pl);
320 extern int              IsWin95(void);
321 extern int              IsWinNT(void);
322
323 extern char *           staticlinkmodules[];
324
325 END_EXTERN_C
326
327 typedef  char *         caddr_t;        /* In malloc.c (core address). */
328
329 /*
330  * handle socket stuff, assuming socket is always available
331  */
332 #include <sys/socket.h>
333 #include <netdb.h>
334
335 #ifdef MYMALLOC
336 #define EMBEDMYMALLOC   /**/
337 /* #define USE_PERL_SBRK        /**/
338 /* #define PERL_SBRK_VIA_MALLOC /**/
339 #endif
340
341 #if defined(PERLDLL) && !defined(PERL_CORE)
342 #define PERL_CORE
343 #endif
344
345 #ifdef USE_BINMODE_SCRIPTS
346 #define PERL_SCRIPT_MODE "rb"
347 EXT void win32_strip_return(struct sv *sv);
348 #else
349 #define PERL_SCRIPT_MODE "r"
350 #define win32_strip_return(sv) NOOP
351 #endif
352
353 /* 
354  * Now Win32 specific per-thread data stuff 
355  */
356
357 struct thread_intern {
358     /* XXX can probably use one buffer instead of several */
359     char                Wstrerror_buffer[512];
360     struct servent      Wservent;
361     char                Wgetlogin_buffer[128];
362 #    ifdef USE_SOCKETS_AS_HANDLES
363     int                 Winit_socktype;
364 #    endif
365 #    ifdef HAVE_DES_FCRYPT
366     char                Wcrypt_buffer[30];
367 #    endif
368 #    ifdef USE_RTL_THREAD_API
369     void *              retv;   /* slot for thread return value */
370 #    endif
371 };
372
373 #ifdef USE_THREADS
374 #  ifndef USE_DECLSPEC_THREAD
375 #    define HAVE_THREAD_INTERN
376 #  endif /* !USE_DECLSPEC_THREAD */
377 #endif /* USE_THREADS */
378
379 #define HAVE_INTERP_INTERN
380 typedef struct {
381     long        num;
382     DWORD       pids[MAXIMUM_WAIT_OBJECTS];
383     HANDLE      handles[MAXIMUM_WAIT_OBJECTS];
384 } child_tab;
385
386 struct interp_intern {
387     char *      perlshell_tokens;
388     char **     perlshell_vec;
389     long        perlshell_items;
390     struct av * fdpid;
391     child_tab * children;
392 #ifdef USE_ITHREADS
393     DWORD       pseudo_id;
394     child_tab * pseudo_children;
395 #endif
396     void *      internal_host;
397 #ifndef USE_THREADS
398     struct thread_intern        thr_intern;
399 #endif
400 };
401
402
403 #define w32_perlshell_tokens    (PL_sys_intern.perlshell_tokens)
404 #define w32_perlshell_vec       (PL_sys_intern.perlshell_vec)
405 #define w32_perlshell_items     (PL_sys_intern.perlshell_items)
406 #define w32_fdpid               (PL_sys_intern.fdpid)
407 #define w32_children            (PL_sys_intern.children)
408 #define w32_num_children        (w32_children->num)
409 #define w32_child_pids          (w32_children->pids)
410 #define w32_child_handles       (w32_children->handles)
411 #define w32_pseudo_id           (PL_sys_intern.pseudo_id)
412 #define w32_pseudo_children     (PL_sys_intern.pseudo_children)
413 #define w32_num_pseudo_children         (w32_pseudo_children->num)
414 #define w32_pseudo_child_pids           (w32_pseudo_children->pids)
415 #define w32_pseudo_child_handles        (w32_pseudo_children->handles)
416 #define w32_internal_host               (PL_sys_intern.internal_host)
417 #ifdef USE_THREADS
418 #  define w32_strerror_buffer   (thr->i.Wstrerror_buffer)
419 #  define w32_getlogin_buffer   (thr->i.Wgetlogin_buffer)
420 #  define w32_crypt_buffer      (thr->i.Wcrypt_buffer)
421 #  define w32_servent           (thr->i.Wservent)
422 #  define w32_init_socktype     (thr->i.Winit_socktype)
423 #else
424 #  define w32_strerror_buffer   (PL_sys_intern.thr_intern.Wstrerror_buffer)
425 #  define w32_getlogin_buffer   (PL_sys_intern.thr_intern.Wgetlogin_buffer)
426 #  define w32_crypt_buffer      (PL_sys_intern.thr_intern.Wcrypt_buffer)
427 #  define w32_servent           (PL_sys_intern.thr_intern.Wservent)
428 #  define w32_init_socktype     (PL_sys_intern.thr_intern.Winit_socktype)
429 #endif /* USE_THREADS */
430
431 /* UNICODE<>ANSI translation helpers */
432 /* Use CP_ACP when mode is ANSI */
433 /* Use CP_UTF8 when mode is UTF8 */
434
435 #define A2WHELPER(lpa, lpw, nBytes)\
436     lpw[0] = 0, MultiByteToWideChar((IN_UTF8) ? CP_UTF8 : CP_ACP, 0, lpa, -1, lpw, (nBytes/sizeof(WCHAR)))
437
438 #define W2AHELPER(lpw, lpa, nChars)\
439     lpa[0] = '\0', WideCharToMultiByte((IN_UTF8) ? CP_UTF8 : CP_ACP, 0, lpw, -1, (LPSTR)lpa, nChars, NULL, NULL)
440
441 #define USING_WIDE()    (PerlEnv_os_id() == VER_PLATFORM_WIN32_NT)
442
443 #ifdef USE_ITHREADS
444 #  define PERL_WAIT_FOR_CHILDREN \
445     STMT_START {                                                        \
446         if (w32_pseudo_children && w32_num_pseudo_children) {           \
447             long children = w32_num_pseudo_children;                    \
448             WaitForMultipleObjects(children,                            \
449                                    w32_pseudo_child_handles,            \
450                                    TRUE, INFINITE);                     \
451             while (children)                                            \
452                 CloseHandle(w32_pseudo_child_handles[--children]);      \
453         }                                                               \
454     } STMT_END
455 #endif
456
457 /*
458  * This provides a layer of functions and macros to ensure extensions will
459  * get to use the same RTL functions as the core.
460  */
461 #include "win32iop.h"
462
463 #endif /* _INC_WIN32_PERL5 */
464