Have symbols for the IoTYPEs.

[p5sagit/p5-mst-13.2.git] / win32 / perlhost.h

diff --git a/win32/perlhost.h b/win32/perlhost.h
index 236a97c..ea0d31d 100644 (file)
--- a/win32/perlhost.h
+++ b/win32/perlhost.h
@@ -10,6 +10,7 @@
 #ifndef ___PerlHost_H___
 #define ___PerlHost_H___
 
+#include <signal.h>
 #include "iperlsys.h"
 #include "vmem.h"
 #include "vdir.h"
@@ -17,8 +18,9 @@
 #if !defined(PERL_OBJECT)
 START_EXTERN_C
 #endif
-extern char *          g_win32_get_privlib(char *pl);
-extern char *          g_win32_get_sitelib(char *pl);
+extern char *          g_win32_get_privlib(const char *pl);
+extern char *          g_win32_get_sitelib(const char *pl);
+extern char *          g_win32_get_vendorlib(const char *pl);
 extern char *          g_getlogin(void);
 extern int             do_spawn2(char *cmd, int exectype);
 #if !defined(PERL_OBJECT)
@@ -475,17 +477,29 @@ PerlEnvOsId(struct IPerlEnv* piPerl)
 }
 
 char*
-PerlEnvLibPath(struct IPerlEnv* piPerl, char *pl)
+PerlEnvLibPath(struct IPerlEnv* piPerl, const char *pl)
 {
     return g_win32_get_privlib(pl);
 }
 
 char*
-PerlEnvSiteLibPath(struct IPerlEnv* piPerl, char *pl)
+PerlEnvSiteLibPath(struct IPerlEnv* piPerl, const char *pl)
 {
     return g_win32_get_sitelib(pl);
 }
 
+char*
+PerlEnvVendorLibPath(struct IPerlEnv* piPerl, const char *pl)
+{
+    return g_win32_get_vendorlib(pl);
+}
+
+void
+PerlEnvGetChildIO(struct IPerlEnv* piPerl, child_IO_table* ptr)
+{
+    win32_get_child_IO(ptr);
+}
+
 struct IPerlEnv perlEnv = 
 {
     PerlEnvGetenv,
@@ -500,6 +514,8 @@ struct IPerlEnv perlEnv =
     PerlEnvOsId,
     PerlEnvLibPath,
     PerlEnvSiteLibPath,
+    PerlEnvVendorLibPath,
+    PerlEnvGetChildIO,
 };
 
 #undef IPERL2HOST
@@ -782,6 +798,21 @@ PerlStdIOFdupopen(struct IPerlStdIO* piPerl, PerlIO* pf)
     int fileno = win32_dup(win32_fileno((FILE*)pf));
 
     /* open the file in the same mode */
+#ifdef __BORLANDC__
+    if(((FILE*)pf)->flags & _F_READ) {
+       mode[0] = 'r';
+       mode[1] = 0;
+    }
+    else if(((FILE*)pf)->flags & _F_WRIT) {
+       mode[0] = 'a';
+       mode[1] = 0;
+    }
+    else if(((FILE*)pf)->flags & _F_RDWR) {
+       mode[0] = 'r';
+       mode[1] = '+';
+       mode[2] = 0;
+    }
+#else
     if(((FILE*)pf)->_flag & _IOREAD) {
        mode[0] = 'r';
        mode[1] = 0;
@@ -795,6 +826,7 @@ PerlStdIOFdupopen(struct IPerlStdIO* piPerl, PerlIO* pf)
        mode[1] = '+';
        mode[2] = 0;
     }
+#endif
 
     /* it appears that the binmode is attached to the 
      * file descriptor so binmode files will be handled
@@ -1608,10 +1640,11 @@ PerlProcWaitpid(struct IPerlProc* piPerl, int pid, int *status, int flags)
 Sighandler_t
 PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode)
 {
-    return 0;
+    return signal(sig, subcode);
 }
 
-static DWORD WINAPI
+#ifdef USE_ITHREADS
+static THREAD_RET_TYPE
 win32_start_child(LPVOID arg)
 {
     PerlInterpreter *my_perl = (PerlInterpreter*)arg;
@@ -1626,7 +1659,7 @@ win32_start_child(LPVOID arg)
 #endif
 
 
-    PERL_SET_INTERP(my_perl);
+    PERL_SET_THX(my_perl);
 
     /* set $$ to pseudo id */
 #ifdef PERL_SYNC_FORK
@@ -1651,7 +1684,7 @@ win32_start_child(LPVOID arg)
 
     {
        dJMPENV;
-       volatile oldscope = PL_scopestack_ix;
+       volatile int oldscope = PL_scopestack_ix;
 
 restart:
        JMPENV_PUSH(status);
@@ -1687,6 +1720,13 @@ restart:
        PL_main_root = Nullop;
     }
 
+    /* close the std handles to avoid fd leaks */
+    {
+       do_close(gv_fetchpv("STDIN", TRUE, SVt_PVIO), FALSE);
+       do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO), FALSE);
+       do_close(gv_fetchpv("STDERR", TRUE, SVt_PVIO), FALSE);
+    }
+
     /* destroy everything (waits for any pseudo-forked children) */
     perl_destruct(my_perl);
     perl_free(my_perl);
@@ -1697,14 +1737,16 @@ restart:
     return (DWORD)status;
 #endif
 }
+#endif /* USE_ITHREADS */
 
 int
 PerlProcFork(struct IPerlProc* piPerl)
 {
     dTHXo;
+#ifdef USE_ITHREADS
     DWORD id;
     HANDLE handle;
-    CPerlHost *h = new CPerlHost();
+    CPerlHost *h = new CPerlHost(*(CPerlHost*)w32_internal_host);
     PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHXo, 1,
                                                 h->m_pHostperlMem,
                                                 h->m_pHostperlMemShared,
@@ -1716,20 +1758,32 @@ PerlProcFork(struct IPerlProc* piPerl)
                                                 h->m_pHostperlSock,
                                                 h->m_pHostperlProc
                                                 );
-#ifdef PERL_SYNC_FORK
+    new_perl->Isys_intern.internal_host = h;
+#  ifdef PERL_SYNC_FORK
     id = win32_start_child((LPVOID)new_perl);
-    PERL_SET_INTERP(aTHXo);
-#else
+    PERL_SET_THX(aTHXo);
+#  else
+#    ifdef USE_RTL_THREAD_API
+    handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child,
+                                   (void*)new_perl, 0, (unsigned*)&id);
+#    else
     handle = CreateThread(NULL, 0, win32_start_child,
                          (LPVOID)new_perl, 0, &id);
-    PERL_SET_INTERP(aTHXo);
-    if (!handle)
-       Perl_croak(aTHX_ "panic: pseudo fork() failed");
+#    endif
+    PERL_SET_THX(aTHXo);       /* XXX perl_clone*() set TLS */
+    if (!handle) {
+       errno = EAGAIN;
+       return -1;
+    }
     w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
     w32_pseudo_child_pids[w32_num_pseudo_children] = id;
     ++w32_num_pseudo_children;
-#endif
+#  endif
     return -(int)id;
+#else
+    Perl_croak(aTHX_ "fork() not implemented!\n");
+    return -1;
+#endif /* USE_ITHREADS */
 }
 
 int
@@ -1867,7 +1921,7 @@ CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
                 struct IPerlDir** ppDir, struct IPerlSock** ppSock,
                 struct IPerlProc** ppProc)
 {
-    m_pvDir = new VDir();
+    m_pvDir = new VDir(0);
     m_pVMem = new VMem();
     m_pVMemShared = new VMem();
     m_pVMemParse =  new VMem();
@@ -1906,7 +1960,7 @@ CPerlHost::CPerlHost(CPerlHost& host)
     m_pVMemParse =  host.GetMemParse();
 
     /* duplicate directory info */
-    m_pvDir = new VDir();
+    m_pvDir = new VDir(0);
     m_pvDir->Init(host.GetDir(), m_pVMem);
 
     CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
@@ -1918,15 +1972,15 @@ CPerlHost::CPerlHost(CPerlHost& host)
     CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir));
     CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock));
     CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc));
-    m_pHostperlMem         = &host.m_hostperlMem;
-    m_pHostperlMemShared    = &host.m_hostperlMemShared;
-    m_pHostperlMemParse            = &host.m_hostperlMemParse;
-    m_pHostperlEnv         = &host.m_hostperlEnv;
-    m_pHostperlStdIO       = &host.m_hostperlStdIO;
-    m_pHostperlLIO         = &host.m_hostperlLIO;
-    m_pHostperlDir         = &host.m_hostperlDir;
-    m_pHostperlSock        = &host.m_hostperlSock;
-    m_pHostperlProc        = &host.m_hostperlProc;
+    m_pHostperlMem         = &m_hostperlMem;
+    m_pHostperlMemShared    = &m_hostperlMemShared;
+    m_pHostperlMemParse            = &m_hostperlMemParse;
+    m_pHostperlEnv         = &m_hostperlEnv;
+    m_pHostperlStdIO       = &m_hostperlStdIO;
+    m_pHostperlLIO         = &m_hostperlLIO;
+    m_pHostperlDir         = &m_hostperlDir;
+    m_pHostperlSock        = &m_hostperlSock;
+    m_pHostperlProc        = &m_hostperlProc;
 
     m_dwEnvCount = 0;
     m_lppEnvList = NULL;