revert optimization in change#4700 (it appears OPpRUNTIME flag
[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 #define _getpid getpid
171 #include <sys/types.h>
172
173 #ifndef DllMain
174 #define DllMain DllEntryPoint
175 #endif
176
177 #pragma warn -ccc       /* "condition is always true/false" */
178 #pragma warn -rch       /* "unreachable code" */
179 #pragma warn -sig       /* "conversion may lose significant digits" */
180 #pragma warn -pia       /* "possibly incorrect assignment" */
181 #pragma warn -par       /* "parameter 'foo' is never used" */
182 #pragma warn -aus       /* "'foo' is assigned a value that is never used" */
183 #pragma warn -use       /* "'foo' is declared but never used" */
184 #pragma warn -csu       /* "comparing signed and unsigned values" */
185 #pragma warn -pro       /* "call to function with no prototype" */
186 #pragma warn -stu       /* "undefined structure 'foo'" */
187
188 /* Borland is picky about a bare member function name used as its ptr */
189 #ifdef PERL_OBJECT
190 #  define MEMBER_TO_FPTR(name)  &(name)
191 #endif
192
193 #endif
194
195 #ifdef _MSC_VER                 /* Microsoft Visual C++ */
196
197 typedef long            uid_t;
198 typedef long            gid_t;
199 typedef unsigned short  mode_t;
200 #pragma  warning(disable: 4018 4035 4101 4102 4244 4245 4761)
201
202 #ifndef PERL_OBJECT
203
204 /* Visual C thinks that a pointer to a member variable is 16 bytes in size. */
205 #define STRUCT_MGVTBL_DEFINITION                                        \
206 struct mgvtbl {                                                         \
207     union {                                                             \
208         int         (CPERLscope(*svt_get))(pTHX_ SV *sv, MAGIC* mg);    \
209         char        handle_VC_problem1[16];                             \
210     };                                                                  \
211     union {                                                             \
212         int         (CPERLscope(*svt_set))(pTHX_ SV *sv, MAGIC* mg);    \
213         char        handle_VC_problem2[16];                             \
214     };                                                                  \
215     union {                                                             \
216         U32         (CPERLscope(*svt_len))(pTHX_ SV *sv, MAGIC* mg);    \
217         char        handle_VC_problem3[16];                             \
218     };                                                                  \
219     union {                                                             \
220         int         (CPERLscope(*svt_clear))(pTHX_ SV *sv, MAGIC* mg);  \
221         char        handle_VC_problem4[16];                             \
222     };                                                                  \
223     union {                                                             \
224         int         (CPERLscope(*svt_free))(pTHX_ SV *sv, MAGIC* mg);   \
225         char        handle_VC_problem5[16];                             \
226     };                                                                  \
227 }
228
229 #define BASEOP_DEFINITION               \
230     OP*         op_next;                \
231     OP*         op_sibling;             \
232     OP*         (CPERLscope(*op_ppaddr))(pTHX);         \
233     char        handle_VC_problem[12];  \
234     PADOFFSET   op_targ;                \
235     OPCODE      op_type;                \
236     U16         op_seq;                 \
237     U8          op_flags;               \
238     U8          op_private;
239
240 #endif /* PERL_OBJECT */
241
242 #endif /* _MSC_VER */
243
244 #ifdef __MINGW32__              /* Minimal Gnu-Win32 */
245
246 typedef long            uid_t;
247 typedef long            gid_t;
248 #ifndef _environ
249 #define _environ        environ
250 #endif
251 #define flushall        _flushall
252 #define fcloseall       _fcloseall
253
254 #undef __attribute__
255 #define __attribute__(x)
256
257 #ifndef CP_UTF8
258 #  define CP_UTF8       65001
259 #endif
260
261 #ifdef PERL_OBJECT
262 #  define MEMBER_TO_FPTR(name)  &(name)
263 #endif
264
265 #ifndef _O_NOINHERIT
266 #  define _O_NOINHERIT  0x0080
267 #  ifndef _NO_OLDNAMES
268 #    define O_NOINHERIT _O_NOINHERIT
269 #  endif
270 #endif
271
272 #endif /* __MINGW32__ */
273
274 /* compatibility stuff for other compilers goes here */
275
276
277 START_EXTERN_C
278
279 /* For UNIX compatibility. */
280
281 extern  uid_t   getuid(void);
282 extern  gid_t   getgid(void);
283 extern  uid_t   geteuid(void);
284 extern  gid_t   getegid(void);
285 extern  int     setuid(uid_t uid);
286 extern  int     setgid(gid_t gid);
287 extern  int     kill(int pid, int sig);
288 extern  void    *sbrk(int need);
289 extern  char *  getlogin(void);
290 extern  int     chown(const char *p, uid_t o, gid_t g);
291
292 #undef   Stat
293 #define  Stat           win32_stat
294
295 #undef   init_os_extras
296 #define  init_os_extras Perl_init_os_extras
297
298 DllExport void          Perl_win32_init(int *argcp, char ***argvp);
299 DllExport void          Perl_init_os_extras();
300 DllExport void          win32_str_os_error(void *sv, DWORD err);
301 DllExport int           RunPerl(int argc, char **argv, char **env);
302 DllExport bool          SetPerlInterpreter(void* interp);
303 DllExport void*         GetPerlInterpreter(void);
304
305 #ifndef USE_SOCKETS_AS_HANDLES
306 extern FILE *           my_fdopen(int, char *);
307 #endif
308 extern int              my_fclose(FILE *);
309 extern int              do_aspawn(void *really, void **mark, void **sp);
310 extern int              do_spawn(char *cmd);
311 extern int              do_spawn_nowait(char *cmd);
312 extern char *           win32_get_privlib(char *pl);
313 extern char *           win32_get_sitelib(char *pl);
314 extern int              IsWin95(void);
315 extern int              IsWinNT(void);
316
317 extern char *           staticlinkmodules[];
318
319 END_EXTERN_C
320
321 typedef  char *         caddr_t;        /* In malloc.c (core address). */
322
323 /*
324  * handle socket stuff, assuming socket is always available
325  */
326 #include <sys/socket.h>
327 #include <netdb.h>
328
329 #ifdef MYMALLOC
330 #define EMBEDMYMALLOC   /**/
331 /* #define USE_PERL_SBRK        /**/
332 /* #define PERL_SBRK_VIA_MALLOC /**/
333 #endif
334
335 #if defined(PERLDLL) && !defined(PERL_CORE)
336 #define PERL_CORE
337 #endif
338
339 #ifdef USE_BINMODE_SCRIPTS
340 #define PERL_SCRIPT_MODE "rb"
341 EXT void win32_strip_return(struct sv *sv);
342 #else
343 #define PERL_SCRIPT_MODE "r"
344 #define win32_strip_return(sv) NOOP
345 #endif
346
347 /* 
348  * Now Win32 specific per-thread data stuff 
349  */
350
351 struct thread_intern {
352     /* XXX can probably use one buffer instead of several */
353     char                Wstrerror_buffer[512];
354     struct servent      Wservent;
355     char                Wgetlogin_buffer[128];
356 #    ifdef USE_SOCKETS_AS_HANDLES
357     int                 Winit_socktype;
358 #    endif
359 #    ifdef HAVE_DES_FCRYPT
360     char                Wcrypt_buffer[30];
361 #    endif
362 #    ifdef USE_RTL_THREAD_API
363     void *              retv;   /* slot for thread return value */
364 #    endif
365 };
366
367 #ifdef USE_THREADS
368 #  ifndef USE_DECLSPEC_THREAD
369 #    define HAVE_THREAD_INTERN
370 #  endif /* !USE_DECLSPEC_THREAD */
371 #endif /* USE_THREADS */
372
373 #define HAVE_INTERP_INTERN
374 typedef struct {
375     long        num;
376     DWORD       pids[MAXIMUM_WAIT_OBJECTS];
377     HANDLE      handles[MAXIMUM_WAIT_OBJECTS];
378 } child_tab;
379
380 struct interp_intern {
381     char *      perlshell_tokens;
382     char **     perlshell_vec;
383     long        perlshell_items;
384     struct av * fdpid;
385     child_tab * children;
386 #ifdef USE_ITHREADS
387     DWORD       pseudo_id;
388     child_tab * pseudo_children;
389 #endif
390     void *      internal_host;
391 #ifndef USE_THREADS
392     struct thread_intern        thr_intern;
393 #endif
394 };
395
396
397 #define w32_perlshell_tokens    (PL_sys_intern.perlshell_tokens)
398 #define w32_perlshell_vec       (PL_sys_intern.perlshell_vec)
399 #define w32_perlshell_items     (PL_sys_intern.perlshell_items)
400 #define w32_fdpid               (PL_sys_intern.fdpid)
401 #define w32_children            (PL_sys_intern.children)
402 #define w32_num_children        (w32_children->num)
403 #define w32_child_pids          (w32_children->pids)
404 #define w32_child_handles       (w32_children->handles)
405 #define w32_pseudo_id           (PL_sys_intern.pseudo_id)
406 #define w32_pseudo_children     (PL_sys_intern.pseudo_children)
407 #define w32_num_pseudo_children         (w32_pseudo_children->num)
408 #define w32_pseudo_child_pids           (w32_pseudo_children->pids)
409 #define w32_pseudo_child_handles        (w32_pseudo_children->handles)
410 #define w32_internal_host               (PL_sys_intern.internal_host)
411 #ifdef USE_THREADS
412 #  define w32_strerror_buffer   (thr->i.Wstrerror_buffer)
413 #  define w32_getlogin_buffer   (thr->i.Wgetlogin_buffer)
414 #  define w32_crypt_buffer      (thr->i.Wcrypt_buffer)
415 #  define w32_servent           (thr->i.Wservent)
416 #  define w32_init_socktype     (thr->i.Winit_socktype)
417 #else
418 #  define w32_strerror_buffer   (PL_sys_intern.thr_intern.Wstrerror_buffer)
419 #  define w32_getlogin_buffer   (PL_sys_intern.thr_intern.Wgetlogin_buffer)
420 #  define w32_crypt_buffer      (PL_sys_intern.thr_intern.Wcrypt_buffer)
421 #  define w32_servent           (PL_sys_intern.thr_intern.Wservent)
422 #  define w32_init_socktype     (PL_sys_intern.thr_intern.Winit_socktype)
423 #endif /* USE_THREADS */
424
425 /* UNICODE<>ANSI translation helpers */
426 /* Use CP_ACP when mode is ANSI */
427 /* Use CP_UTF8 when mode is UTF8 */
428
429 #define A2WHELPER(lpa, lpw, nBytes)\
430     lpw[0] = 0, MultiByteToWideChar((IN_UTF8) ? CP_UTF8 : CP_ACP, 0, lpa, -1, lpw, (nBytes/sizeof(WCHAR)))
431
432 #define W2AHELPER(lpw, lpa, nChars)\
433     lpa[0] = '\0', WideCharToMultiByte((IN_UTF8) ? CP_UTF8 : CP_ACP, 0, lpw, -1, (LPSTR)lpa, nChars, NULL, NULL)
434
435 #define USING_WIDE()    (PerlEnv_os_id() == VER_PLATFORM_WIN32_NT)
436
437 #ifdef USE_ITHREADS
438 #  define PERL_WAIT_FOR_CHILDREN \
439     STMT_START {                                                        \
440         if (w32_pseudo_children && w32_num_pseudo_children) {           \
441             long children = w32_num_pseudo_children;                    \
442             WaitForMultipleObjects(children,                            \
443                                    w32_pseudo_child_handles,            \
444                                    TRUE, INFINITE);                     \
445             while (children)                                            \
446                 CloseHandle(w32_pseudo_child_handles[--children]);      \
447         }                                                               \
448     } STMT_END
449 #endif
450
451 /*
452  * This provides a layer of functions and macros to ensure extensions will
453  * get to use the same RTL functions as the core.
454  */
455 #include "win32iop.h"
456
457 #endif /* _INC_WIN32_PERL5 */
458