more exported symbols needed for build on windows
[p5sagit/p5-mst-13.2.git] / win32 / win32.h
index a072b87..69a4caf 100644 (file)
@@ -9,33 +9,34 @@
 #ifndef  _INC_WIN32_PERL5
 #define  _INC_WIN32_PERL5
 
-#ifdef PERL_OBJECT
+#ifndef _WIN32_WINNT
+#  define _WIN32_WINNT 0x0400     /* needed for TryEnterCriticalSection() etc. */
+#endif
+
+#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
 
-#ifdef __GNUC__
-typedef long long __int64;
-#  define Win32_Winsock
-/* GCC does not do __declspec() - render it a nop 
- * and turn on options to avoid importing data 
- */
-#ifndef __declspec
-#  define __declspec(x)
+#if defined(PERL_IMPLICIT_CONTEXT)
+#  define PERL_GET_INTERP      ((PerlInterpreter*)GetPerlInterpreter())
+#  define PERL_SET_INTERP(i)   (SetPerlInterpreter(i))
 #endif
-#  ifndef PERL_OBJECT
-#    define PERL_GLOBAL_STRUCT
-#    ifndef MULTIPLICITY
-#      define MULTIPLICITY
-#    endif
+
+#ifdef __GNUC__
+#  ifndef __int64              /* some versions seem to #define it already */
+#    define __int64 long long
 #  endif
+#  define Win32_Winsock
 #endif
 
 /* Define DllExport akin to perl's EXT, 
@@ -44,6 +45,8 @@ typedef long long __int64;
  * otherwise import it.
  */
 
+/* now even GCC supports __declspec() */
+
 #if defined(PERL_OBJECT)
 #define DllExport
 #else
@@ -120,15 +123,18 @@ struct utsname {
 #define PERL_SOCK_SYSREAD_IS_RECV
 #define PERL_SOCK_SYSWRITE_IS_SEND
 
+#define PERL_NO_FORCE_LINK             /* no need for PL_force_link_funcs */
 
 /* 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(). */
 /*#define USE_WIN32_RTL_ENV */
 
-/* Define USE_FIXED_OSFHANDLE to fix VC's _open_osfhandle() on W95.
- * Can only enable it if not using the DLL CRT (it doesn't expose internals) */
-#if defined(_MSC_VER) && !defined(_DLL) && defined(_M_IX86)
+/* Define USE_FIXED_OSFHANDLE to fix MSVCRT's _open_osfhandle() on W95.
+   It now uses some black magic to work seamlessly with the DLL CRT and
+   works with MSVC++ 4.0+ or GCC/Mingw32
+       -- BKS 1-24-2000 */
+#if (defined(_M_IX86) && _MSC_VER >= 1000) || defined(__MINGW32__)
 #define USE_FIXED_OSFHANDLE
 #endif
 
@@ -156,6 +162,7 @@ struct utsname {
 
 #define _access access
 #define _chdir chdir
+#define _getpid getpid
 #include <sys/types.h>
 
 #ifndef DllMain
@@ -175,65 +182,23 @@ struct utsname {
 
 /* 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
 
+/* Borland C thinks that a pointer to a member variable is 12 bytes in size. */
+#define PERL_MEMBER_PTR_SIZE   12
+
 #endif
 
 #ifdef _MSC_VER                        /* Microsoft Visual C++ */
 
 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))      _((SV *sv, MAGIC* mg)); \
-       char        handle_VC_problem1[16];                             \
-    };                                                                 \
-    union {                                                            \
-       int         (CPERLscope(*svt_set))      _((SV *sv, MAGIC* mg)); \
-       char        handle_VC_problem2[16];                             \
-    };                                                                 \
-    union {                                                            \
-       U32         (CPERLscope(*svt_len))      _((SV *sv, MAGIC* mg)); \
-       char        handle_VC_problem3[16];                             \
-    };                                                                 \
-    union {                                                            \
-       int         (CPERLscope(*svt_clear))    _((SV *sv, MAGIC* mg)); \
-       char        handle_VC_problem4[16];                             \
-    };                                                                 \
-    union {                                                            \
-       int         (CPERLscope(*svt_free))     _((SV *sv, MAGIC* mg)); \
-       char        handle_VC_problem5[16];                             \
-    };                                                                 \
-}
-
-#define BASEOP_DEFINITION              \
-    OP*                op_next;                \
-    OP*                op_sibling;             \
-    OP*                (CPERLscope(*op_ppaddr))_((ARGSproto));         \
-    char       handle_VC_problem[12];  \
-    PADOFFSET  op_targ;                \
-    OPCODE     op_type;                \
-    U16                op_seq;                 \
-    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 */
+#define PERL_MEMBER_PTR_SIZE   16
 
 #endif /* _MSC_VER */
 
@@ -247,15 +212,12 @@ typedef long              gid_t;
 #define flushall       _flushall
 #define fcloseall      _fcloseall
 
-#ifdef PERL_OBJECT
-#define FUNC_NAME_TO_PTR(name) &(name)
+#ifndef CP_UTF8
+#  define CP_UTF8      65001
 #endif
 
-#ifndef _O_NOINHERIT
-#  define _O_NOINHERIT 0x0080
-#  ifndef _NO_OLDNAMES
-#    define O_NOINHERIT        _O_NOINHERIT
-#  endif
+#ifdef PERL_OBJECT
+#  define MEMBER_TO_FPTR(name) &(name)
 #endif
 
 #ifndef _O_NOINHERIT
@@ -270,6 +232,45 @@ typedef long               gid_t;
 /* compatibility stuff for other compilers goes here */
 
 
+#if !defined(PERL_OBJECT) && defined(PERL_CAPI) && defined(PERL_MEMBER_PTR_SIZE)
+#  define STRUCT_MGVTBL_DEFINITION \
+struct mgvtbl {                                                                \
+    union {                                                            \
+       int         (CPERLscope(*svt_get))(pTHX_ SV *sv, MAGIC* mg);    \
+       char        handle_VC_problem1[PERL_MEMBER_PTR_SIZE];           \
+    };                                                                 \
+    union {                                                            \
+       int         (CPERLscope(*svt_set))(pTHX_ SV *sv, MAGIC* mg);    \
+       char        handle_VC_problem2[PERL_MEMBER_PTR_SIZE];           \
+    };                                                                 \
+    union {                                                            \
+       U32         (CPERLscope(*svt_len))(pTHX_ SV *sv, MAGIC* mg);    \
+       char        handle_VC_problem3[PERL_MEMBER_PTR_SIZE];           \
+    };                                                                 \
+    union {                                                            \
+       int         (CPERLscope(*svt_clear))(pTHX_ SV *sv, MAGIC* mg);  \
+       char        handle_VC_problem4[PERL_MEMBER_PTR_SIZE];           \
+    };                                                                 \
+    union {                                                            \
+       int         (CPERLscope(*svt_free))(pTHX_ SV *sv, MAGIC* mg);   \
+       char        handle_VC_problem5[PERL_MEMBER_PTR_SIZE];           \
+    };                                                                 \
+}
+
+#  define BASEOP_DEFINITION \
+    OP*                op_next;                                                \
+    OP*                op_sibling;                                             \
+    OP*                (CPERLscope(*op_ppaddr))(pTHX);                         \
+    char       handle_VC_problem[PERL_MEMBER_PTR_SIZE-sizeof(OP*)];    \
+    PADOFFSET  op_targ;                                                \
+    OPCODE     op_type;                                                \
+    U16                op_seq;                                                 \
+    U8         op_flags;                                               \
+    U8         op_private;
+
+#endif /* !PERL_OBJECT && PERL_CAPI && PERL_MEMBER_PTR_SIZE */
+
+
 START_EXTERN_C
 
 /* For UNIX compatibility. */
@@ -292,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 *);
@@ -302,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);
@@ -330,18 +333,43 @@ typedef  char *           caddr_t;        /* In malloc.c (core address). */
 #define PERL_CORE
 #endif
 
-#ifdef USE_BINMODE_SCRIPTS
-#define PERL_SCRIPT_MODE "rb"
-EXT void win32_strip_return(struct sv *sv);
+#ifdef PERL_TEXTMODE_SCRIPTS
+#  define PERL_SCRIPT_MODE             "r"
 #else
-#define PERL_SCRIPT_MODE "r"
-#define win32_strip_return(sv) NOOP
+#  define PERL_SCRIPT_MODE             "rb"
 #endif
 
+/* 
+ * Now Win32 specific per-thread data stuff 
+ */
+
+struct thread_intern {
+    /* XXX can probably use one buffer instead of several */
+    char               Wstrerror_buffer[512];
+    struct servent     Wservent;
+    char               Wgetlogin_buffer[128];
+#    ifdef USE_SOCKETS_AS_HANDLES
+    int                        Winit_socktype;
+#    endif
+#    ifdef HAVE_DES_FCRYPT
+    char               Wcrypt_buffer[30];
+#    endif
+#    ifdef USE_RTL_THREAD_API
+    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 {
@@ -350,7 +378,14 @@ struct interp_intern {
     long       perlshell_items;
     struct av *        fdpid;
     child_tab *        children;
-    HANDLE     child_handles[MAXIMUM_WAIT_OBJECTS];
+#ifdef USE_ITHREADS
+    DWORD      pseudo_id;
+    child_tab *        pseudo_children;
+#endif
+    void *     internal_host;
+#ifndef USE_THREADS
+    struct thread_intern       thr_intern;
+#endif
 };
 
 
@@ -361,33 +396,58 @@ struct interp_intern {
 #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)
-
-/* 
- * Now Win32 specific per-thread data stuff 
- */
-
+#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
-#  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
-#    ifdef HAVE_DES_FCRYPT
-    char               Wcrypt_buffer[30];
-#    endif
-#    ifdef USE_RTL_THREAD_API
-    void *             retv;   /* slot for thread return value */
-#    endif
-};
-#  endif /* !USE_DECLSPEC_THREAD */
+#  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 */
+