support PERL_IMPLICIT_SYS with MULTIPLICITY/USE_THREADS on
[p5sagit/p5-mst-13.2.git] / win32 / win32.h
index fef3cbc..0f6f708 100644 (file)
@@ -9,20 +9,29 @@
 #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;
+#  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 
@@ -83,6 +92,18 @@ 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
@@ -161,11 +182,9 @@ struct tms {
 #pragma warn -pro      /* "call to function with no prototype" */
 #pragma warn -stu      /* "undefined structure 'foo'" */
 
-#define USE_RTL_WAIT   /* Borland has a working wait() */
-
 /* 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
@@ -174,6 +193,7 @@ 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
@@ -182,23 +202,23 @@ typedef long              gid_t;
 #define STRUCT_MGVTBL_DEFINITION                                       \
 struct mgvtbl {                                                                \
     union {                                                            \
-       int         (CPERLscope(*svt_get))      _((SV *sv, MAGIC* mg)); \
+       int         (CPERLscope(*svt_get))(pTHX_ SV *sv, MAGIC* mg);    \
        char        handle_VC_problem1[16];                             \
     };                                                                 \
     union {                                                            \
-       int         (CPERLscope(*svt_set))      _((SV *sv, MAGIC* mg)); \
+       int         (CPERLscope(*svt_set))(pTHX_ SV *sv, MAGIC* mg);    \
        char        handle_VC_problem2[16];                             \
     };                                                                 \
     union {                                                            \
-       U32         (CPERLscope(*svt_len))      _((SV *sv, MAGIC* mg)); \
+       U32         (CPERLscope(*svt_len))(pTHX_ SV *sv, MAGIC* mg);    \
        char        handle_VC_problem3[16];                             \
     };                                                                 \
     union {                                                            \
-       int         (CPERLscope(*svt_clear))    _((SV *sv, MAGIC* mg)); \
+       int         (CPERLscope(*svt_clear))(pTHX_ SV *sv, MAGIC* mg);  \
        char        handle_VC_problem4[16];                             \
     };                                                                 \
     union {                                                            \
-       int         (CPERLscope(*svt_free))     _((SV *sv, MAGIC* mg)); \
+       int         (CPERLscope(*svt_free))(pTHX_ SV *sv, MAGIC* mg);   \
        char        handle_VC_problem5[16];                             \
     };                                                                 \
 }
@@ -206,7 +226,7 @@ struct mgvtbl {                                                             \
 #define BASEOP_DEFINITION              \
     OP*                op_next;                \
     OP*                op_sibling;             \
-    OP*                (CPERLscope(*op_ppaddr))_((ARGSproto));         \
+    OP*                (CPERLscope(*op_ppaddr))(pTHX);         \
     char       handle_VC_problem[12];  \
     PADOFFSET  op_targ;                \
     OPCODE     op_type;                \
@@ -214,15 +234,6 @@ struct mgvtbl {                                                            \
     U8         op_flags;               \
     U8         op_private;
 
-#define UNION_ANY_DEFINITION union any {               \
-    void*      any_ptr;                                \
-    I32                any_i32;                                \
-    IV         any_iv;                                 \
-    long       any_long;                               \
-    void       (CPERLscope(*any_dptr)) _((void*));     \
-    char       handle_VC_problem[16];                  \
-}
-
 #endif /* PERL_OBJECT */
 
 #endif /* _MSC_VER */
@@ -238,7 +249,7 @@ typedef long                gid_t;
 #define fcloseall      _fcloseall
 
 #ifdef PERL_OBJECT
-#define FUNC_NAME_TO_PTR(name) &(name)
+#  define MEMBER_TO_FPTR(name) &(name)
 #endif
 
 #ifndef _O_NOINHERIT
@@ -282,8 +293,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 *);
@@ -292,7 +306,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);
@@ -329,26 +342,37 @@ EXT void win32_strip_return(struct sv *sv);
 #endif
 
 #define HAVE_INTERP_INTERN
+typedef struct {
+    long       num;
+    DWORD      pids[MAXIMUM_WAIT_OBJECTS];
+} child_tab;
+
+struct host_link {
+    char *     nameId;
+    void *     host_data;
+    struct host_link * next;
+};
+
 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
+    char *     perlshell_tokens;
+    char **    perlshell_vec;
+    long       perlshell_items;
+    struct av *        fdpid;
+    child_tab *        children;
+    HANDLE     child_handles[MAXIMUM_WAIT_OBJECTS];
+    struct host_link * hostlist;
 };
 
-#define w32_perlshell_tokens   (PL_sys_intern.w32_perlshell_tokens)
-#define w32_perlshell_vec      (PL_sys_intern.w32_perlshell_vec)
-#define w32_perlshell_items    (PL_sys_intern.w32_perlshell_items)
-#define w32_fdpid              (PL_sys_intern.w32_fdpid)
 
-#ifndef USE_RTL_WAIT
-#  define w32_num_children     (PL_sys_intern.w32_num_children)
-#  define w32_child_pids       (PL_sys_intern.w32_child_pids)
-#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      (PL_sys_intern.child_handles)
+#define w32_host_link          (PL_sys_intern.hostlist)
 
 /* 
  * Now Win32 specific per-thread data stuff 
@@ -377,4 +401,23 @@ struct thread_intern {
 #  endif /* !USE_DECLSPEC_THREAD */
 #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)
+
+/*
+ * 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 */
+