more complete pseudo-fork() support for Windows
[p5sagit/p5-mst-13.2.git] / win32 / win32.h
index eaced28..856232a 100644 (file)
@@ -9,28 +9,42 @@
 #ifndef  _INC_WIN32_PERL5
 #define  _INC_WIN32_PERL5
 
-#ifdef PERL_OBJECT
+#if defined(PERL_OBJECT) || defined(PERL_IMPLICIT_SYS) || defined(PERL_CAPI)
+#  define DYNAMIC_ENV_FETCH
+#  define ENV_HV_NAME "___ENV_HV_NAME___"
+#  define HAS_GETENV_LEN
+#  define prime_env_iter()
 #  define WIN32IO_IS_STDIO             /* don't pull in custom stdio layer */
+#  define WIN32SCK_IS_STDSCK           /* don't pull in custom wsock layer */
 #  ifdef PERL_GLOBAL_STRUCT
-#    error PERL_GLOBAL_STRUCT cannot be defined with PERL_OBJECT
+#    error PERL_GLOBAL_STRUCT cannot be defined with PERL_IMPLICIT_SYS
 #  endif
 #  define win32_get_privlib PerlEnv_lib_path
 #  define win32_get_sitelib PerlEnv_sitelib_path
 #endif
 
+#if defined(PERL_IMPLICIT_CONTEXT)
+#  define PERL_GET_INTERP      ((PerlInterpreter*)GetPerlInterpreter())
+#  define PERL_SET_INTERP(i)   (SetPerlInterpreter(i))
+#endif
+
 #ifdef __GNUC__
-typedef long long __int64;
-#define Win32_Winsock
-#  ifdef __cplusplus
-#undef __attribute__           /* seems broken in 2.8.0 */
-#define __attribute__(p)
+#  ifndef __int64              /* some versions seem to #define it already */
+#    define __int64 long long
 #  endif
+#  define Win32_Winsock
 /* GCC does not do __declspec() - render it a nop 
  * and turn on options to avoid importing data 
  */
-#define __declspec(x)
-#define PERL_GLOBAL_STRUCT
-#define MULTIPLICITY
+#ifndef __declspec
+#  define __declspec(x)
+#endif
+#  ifndef PERL_OBJECT
+#    define PERL_GLOBAL_STRUCT
+#    ifndef MULTIPLICITY
+#      define MULTIPLICITY
+#    endif
+#  endif
 #endif
 
 /* Define DllExport akin to perl's EXT, 
@@ -78,7 +92,20 @@ struct tms {
        long    tms_cstime;
 };
 
+#ifndef SYS_NMLN
+#define SYS_NMLN       257
+#endif
+
+struct utsname {
+    char sysname[SYS_NMLN];
+    char nodename[SYS_NMLN];
+    char release[SYS_NMLN];
+    char version[SYS_NMLN];
+    char machine[SYS_NMLN];
+};
+
 #ifndef START_EXTERN_C
+#undef EXTERN_C
 #ifdef __cplusplus
 #  define START_EXTERN_C extern "C" {
 #  define END_EXTERN_C }
@@ -98,6 +125,11 @@ struct tms {
  * real filehandles. XXX Should always be defined (the other version is untested) */
 #define USE_SOCKETS_AS_HANDLES
 
+/* read() and write() aren't transparent for socket handles */
+#define PERL_SOCK_SYSREAD_IS_RECV
+#define PERL_SOCK_SYSWRITE_IS_SEND
+
+
 /* if USE_WIN32_RTL_ENV is not defined, Perl uses direct Win32 calls
  * to read the environment, bypassing the runtime's (usually broken)
  * facilities for accessing the same.  See note in util.c/my_setenv(). */
@@ -111,10 +143,22 @@ struct tms {
 
 #define ENV_IS_CASELESS
 
-#ifndef VER_PLATFORM_WIN32_WINDOWS     /* VC-2.0 headers dont have this */
+#ifndef VER_PLATFORM_WIN32_WINDOWS     /* VC-2.0 headers don't have this */
 #define VER_PLATFORM_WIN32_WINDOWS     1
 #endif
 
+#ifndef FILE_SHARE_DELETE              /* VC-4.0 headers don't have this */
+#define FILE_SHARE_DELETE              0x00000004
+#endif
+
+/* access() mode bits */
+#ifndef R_OK
+#  define      R_OK    4
+#  define      W_OK    2
+#  define      X_OK    1
+#  define      F_OK    0
+#endif
+
 /* Compiler-specific stuff. */
 
 #ifdef __BORLANDC__            /* Borland C++ */
@@ -136,12 +180,11 @@ struct tms {
 #pragma warn -use      /* "'foo' is declared but never used" */
 #pragma warn -csu      /* "comparing signed and unsigned values" */
 #pragma warn -pro      /* "call to function with no prototype" */
-
-#define USE_RTL_WAIT   /* Borland has a working wait() */
+#pragma warn -stu      /* "undefined structure 'foo'" */
 
 /* Borland is picky about a bare member function name used as its ptr */
 #ifdef PERL_OBJECT
-#define FUNC_NAME_TO_PTR(name) &(name)
+#  define MEMBER_TO_FPTR(name) &(name)
 #endif
 
 #endif
@@ -150,18 +193,72 @@ struct tms {
 
 typedef long           uid_t;
 typedef long           gid_t;
+typedef unsigned short mode_t;
 #pragma  warning(disable: 4018 4035 4101 4102 4244 4245 4761)
 
+#ifndef PERL_OBJECT
+
+/* Visual C thinks that a pointer to a member variable is 16 bytes in size. */
+#define STRUCT_MGVTBL_DEFINITION                                       \
+struct mgvtbl {                                                                \
+    union {                                                            \
+       int         (CPERLscope(*svt_get))(pTHX_ SV *sv, MAGIC* mg);    \
+       char        handle_VC_problem1[16];                             \
+    };                                                                 \
+    union {                                                            \
+       int         (CPERLscope(*svt_set))(pTHX_ SV *sv, MAGIC* mg);    \
+       char        handle_VC_problem2[16];                             \
+    };                                                                 \
+    union {                                                            \
+       U32         (CPERLscope(*svt_len))(pTHX_ SV *sv, MAGIC* mg);    \
+       char        handle_VC_problem3[16];                             \
+    };                                                                 \
+    union {                                                            \
+       int         (CPERLscope(*svt_clear))(pTHX_ SV *sv, MAGIC* mg);  \
+       char        handle_VC_problem4[16];                             \
+    };                                                                 \
+    union {                                                            \
+       int         (CPERLscope(*svt_free))(pTHX_ SV *sv, MAGIC* mg);   \
+       char        handle_VC_problem5[16];                             \
+    };                                                                 \
+}
+
+#define BASEOP_DEFINITION              \
+    OP*                op_next;                \
+    OP*                op_sibling;             \
+    OP*                (CPERLscope(*op_ppaddr))(pTHX);         \
+    char       handle_VC_problem[12];  \
+    PADOFFSET  op_targ;                \
+    OPCODE     op_type;                \
+    U16                op_seq;                 \
+    U8         op_flags;               \
+    U8         op_private;
+
+#endif /* PERL_OBJECT */
+
 #endif /* _MSC_VER */
 
 #ifdef __MINGW32__             /* Minimal Gnu-Win32 */
 
 typedef long           uid_t;
 typedef long           gid_t;
+#ifndef _environ
 #define _environ       environ
+#endif
 #define flushall       _flushall
 #define fcloseall      _fcloseall
 
+#undef __attribute__
+#define __attribute__(x)
+
+#ifndef CP_UTF8
+#  define CP_UTF8      65001
+#endif
+
+#ifdef PERL_OBJECT
+#  define MEMBER_TO_FPTR(name) &(name)
+#endif
+
 #ifndef _O_NOINHERIT
 #  define _O_NOINHERIT 0x0080
 #  ifndef _NO_OLDNAMES
@@ -203,8 +300,11 @@ extern     int     chown(const char *p, uid_t o, gid_t g);
 #define  init_os_extras Perl_init_os_extras
 
 DllExport void         Perl_win32_init(int *argcp, char ***argvp);
-DllExport void         Perl_init_os_extras(void);
+DllExport void         Perl_init_os_extras();
 DllExport void         win32_str_os_error(void *sv, DWORD err);
+DllExport int          RunPerl(int argc, char **argv, char **env);
+DllExport bool         SetPerlInterpreter(void* interp);
+DllExport void*                GetPerlInterpreter(void);
 
 #ifndef USE_SOCKETS_AS_HANDLES
 extern FILE *          my_fdopen(int, char *);
@@ -213,7 +313,6 @@ extern int          my_fclose(FILE *);
 extern int             do_aspawn(void *really, void **mark, void **sp);
 extern int             do_spawn(char *cmd);
 extern int             do_spawn_nowait(char *cmd);
-extern char            do_exec(char *cmd);
 extern char *          win32_get_privlib(char *pl);
 extern char *          win32_get_sitelib(char *pl);
 extern int             IsWin95(void);
@@ -249,42 +348,15 @@ EXT void win32_strip_return(struct sv *sv);
 #define win32_strip_return(sv) NOOP
 #endif
 
-#define HAVE_INTERP_INTERN
-struct interp_intern {
-    char *     w32_perlshell_tokens;
-    char **    w32_perlshell_vec;
-    long       w32_perlshell_items;
-    struct av *        w32_fdpid;
-#ifndef USE_RTL_WAIT
-    long       w32_num_children;
-    HANDLE     w32_child_pids[MAXIMUM_WAIT_OBJECTS];
-#endif
-};
-
-#define w32_perlshell_tokens   (sys_intern.w32_perlshell_tokens)
-#define w32_perlshell_vec      (sys_intern.w32_perlshell_vec)
-#define w32_perlshell_items    (sys_intern.w32_perlshell_items)
-#define w32_fdpid              (sys_intern.w32_fdpid)
-
-#ifndef USE_RTL_WAIT
-#  define w32_num_children     (sys_intern.w32_num_children)
-#  define w32_child_pids       (sys_intern.w32_child_pids)
-#endif
-
 /* 
  * Now Win32 specific per-thread data stuff 
  */
 
-#ifdef USE_THREADS
-#  ifndef USE_DECLSPEC_THREAD
-#    define HAVE_THREAD_INTERN
-
 struct thread_intern {
     /* XXX can probably use one buffer instead of several */
     char               Wstrerror_buffer[512];
     struct servent     Wservent;
     char               Wgetlogin_buffer[128];
-    char               Ww32_perllib_root[MAX_PATH+1];
 #    ifdef USE_SOCKETS_AS_HANDLES
     int                        Winit_socktype;
 #    endif
@@ -295,7 +367,96 @@ struct thread_intern {
     void *             retv;   /* slot for thread return value */
 #    endif
 };
+
+#ifdef USE_THREADS
+#  ifndef USE_DECLSPEC_THREAD
+#    define HAVE_THREAD_INTERN
 #  endif /* !USE_DECLSPEC_THREAD */
 #endif /* USE_THREADS */
 
+#define HAVE_INTERP_INTERN
+typedef struct {
+    long       num;
+    DWORD      pids[MAXIMUM_WAIT_OBJECTS];
+    HANDLE     handles[MAXIMUM_WAIT_OBJECTS];
+} child_tab;
+
+struct interp_intern {
+    char *     perlshell_tokens;
+    char **    perlshell_vec;
+    long       perlshell_items;
+    struct av *        fdpid;
+    child_tab *        children;
+#ifdef USE_ITHREADS
+    DWORD      pseudo_id;
+    child_tab *        pseudo_children;
+#endif
+    void *     internal_host;
+#ifndef USE_THREADS
+    struct thread_intern       thr_intern;
+#endif
+};
+
+
+#define w32_perlshell_tokens   (PL_sys_intern.perlshell_tokens)
+#define w32_perlshell_vec      (PL_sys_intern.perlshell_vec)
+#define w32_perlshell_items    (PL_sys_intern.perlshell_items)
+#define w32_fdpid              (PL_sys_intern.fdpid)
+#define w32_children           (PL_sys_intern.children)
+#define w32_num_children       (w32_children->num)
+#define w32_child_pids         (w32_children->pids)
+#define w32_child_handles      (w32_children->handles)
+#define w32_pseudo_id          (PL_sys_intern.pseudo_id)
+#define w32_pseudo_children    (PL_sys_intern.pseudo_children)
+#define w32_num_pseudo_children                (w32_pseudo_children->num)
+#define w32_pseudo_child_pids          (w32_pseudo_children->pids)
+#define w32_pseudo_child_handles       (w32_pseudo_children->handles)
+#define w32_internal_host              (PL_sys_intern.internal_host)
+#ifdef USE_THREADS
+#  define w32_strerror_buffer  (thr->i.Wstrerror_buffer)
+#  define w32_getlogin_buffer  (thr->i.Wgetlogin_buffer)
+#  define w32_crypt_buffer     (thr->i.Wcrypt_buffer)
+#  define w32_servent          (thr->i.Wservent)
+#  define w32_init_socktype    (thr->i.Winit_socktype)
+#else
+#  define w32_strerror_buffer  (PL_sys_intern.thr_intern.Wstrerror_buffer)
+#  define w32_getlogin_buffer  (PL_sys_intern.thr_intern.Wgetlogin_buffer)
+#  define w32_crypt_buffer     (PL_sys_intern.thr_intern.Wcrypt_buffer)
+#  define w32_servent          (PL_sys_intern.thr_intern.Wservent)
+#  define w32_init_socktype    (PL_sys_intern.thr_intern.Winit_socktype)
+#endif /* USE_THREADS */
+
+/* UNICODE<>ANSI translation helpers */
+/* Use CP_ACP when mode is ANSI */
+/* Use CP_UTF8 when mode is UTF8 */
+
+#define A2WHELPER(lpa, lpw, nBytes)\
+    lpw[0] = 0, MultiByteToWideChar((IN_UTF8) ? CP_UTF8 : CP_ACP, 0, lpa, -1, lpw, (nBytes/sizeof(WCHAR)))
+
+#define W2AHELPER(lpw, lpa, nChars)\
+    lpa[0] = '\0', WideCharToMultiByte((IN_UTF8) ? CP_UTF8 : CP_ACP, 0, lpw, -1, (LPSTR)lpa, nChars, NULL, NULL)
+
+#define USING_WIDE()   (PerlEnv_os_id() == VER_PLATFORM_WIN32_NT)
+
+#ifdef USE_ITHREADS
+#  define PERL_WAIT_FOR_CHILDREN \
+    STMT_START {                                                       \
+       if (w32_pseudo_children && w32_num_pseudo_children) {           \
+           long children = w32_num_pseudo_children;                    \
+           WaitForMultipleObjects(children,                            \
+                                  w32_pseudo_child_handles,            \
+                                  TRUE, INFINITE);                     \
+           while (children)                                            \
+               CloseHandle(w32_pseudo_child_handles[--children]);      \
+       }                                                               \
+    } STMT_END
+#endif
+
+/*
+ * This provides a layer of functions and macros to ensure extensions will
+ * get to use the same RTL functions as the core.
+ */
+#include "win32iop.h"
+
 #endif /* _INC_WIN32_PERL5 */
+