Re: Copious warnings from Sys::Syslog

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

diff --git a/win32/perlhost.h b/win32/perlhost.h
index 268a112..c0b53d6 100644 (file)
--- a/win32/perlhost.h
+++ b/win32/perlhost.h
@@ -7,6 +7,8 @@
  *    License or the Artistic License, as specified in the README file.
  */
 
+#define CHECK_HOST_INTERP
+
 #ifndef ___PerlHost_H___
 #define ___PerlHost_H___
 
@@ -78,7 +80,7 @@ public:
        void *result;
        GetLockShared();
        result = m_pVMemShared->Malloc(size);
-       FreeLockShared()
+       FreeLockShared();
        return result;
     };
     inline void* ReallocShared(void* ptr, size_t size)
@@ -86,14 +88,14 @@ public:
        void *result;
        GetLockShared();
        result = m_pVMemShared->Realloc(ptr, size);
-       FreeLockShared()
+       FreeLockShared();
        return result;
     };
     inline void FreeShared(void* ptr)
     {
        GetLockShared();
        m_pVMemShared->Free(ptr);
-       FreeLockShared()
+       FreeLockShared();
     };
     inline void* CallocShared(size_t num, size_t size)
     {
@@ -210,29 +212,42 @@ protected:
 
     DWORD   m_dwEnvCount;
     LPSTR*  m_lppEnvList;
+    BOOL    m_bTopLevel;       // is this a toplevel host?
     static long num_hosts;
 public:
     inline  int LastHost(void) { return num_hosts == 1L; };
+    struct interpreter *host_perl;
 };
 
 long CPerlHost::num_hosts = 0L;
 
+extern "C" void win32_checkTLS(struct interpreter *host_perl);
 
-#define STRUCT2PTR(x, y) (CPerlHost*)(((LPBYTE)x)-offsetof(CPerlHost, y))
+#define STRUCT2RAWPTR(x, y) (CPerlHost*)(((LPBYTE)x)-offsetof(CPerlHost, y))
+#ifdef CHECK_HOST_INTERP
+inline CPerlHost* CheckInterp(CPerlHost *host)
+{
+ win32_checkTLS(host->host_perl);
+ return host;
+}
+#define STRUCT2PTR(x, y) CheckInterp(STRUCT2RAWPTR(x, y))
+#else
+#define STRUCT2PTR(x, y) STRUCT2RAWPTR(x, y)
+#endif
 
 inline CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl)
 {
-    return STRUCT2PTR(piPerl, m_hostperlMem);
+    return STRUCT2RAWPTR(piPerl, m_hostperlMem);
 }
 
 inline CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl)
 {
-    return STRUCT2PTR(piPerl, m_hostperlMemShared);
+    return STRUCT2RAWPTR(piPerl, m_hostperlMemShared);
 }
 
 inline CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl)
 {
-    return STRUCT2PTR(piPerl, m_hostperlMemParse);
+    return STRUCT2RAWPTR(piPerl, m_hostperlMemParse);
 }
 
 inline CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl)
@@ -1435,9 +1450,7 @@ PerlSockSocket(struct IPerlSock* piPerl, int af, int type, int protocol)
 int
 PerlSockSocketpair(struct IPerlSock* piPerl, int domain, int type, int protocol, int* fds)
 {
-    dTHX;
-    Perl_croak(aTHX_ "socketpair not implemented!\n");
-    return 0;
+    return Perl_my_socketpair(domain, type, protocol, fds);
 }
 
 int
@@ -1665,7 +1678,7 @@ PerlProcWaitpid(struct IPerlProc* piPerl, int pid, int *status, int flags)
 Sighandler_t
 PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode)
 {
-    return signal(sig, subcode);
+    return win32_signal(sig, subcode);
 }
 
 #ifdef USE_ITHREADS
@@ -1682,6 +1695,7 @@ win32_start_child(LPVOID arg)
 
 
     PERL_SET_THX(my_perl);
+    win32_checkTLS(my_perl);
 
     /* set $$ to pseudo id */
 #ifdef PERL_SYNC_FORK
@@ -1694,8 +1708,12 @@ win32_start_child(LPVOID arg)
            w32_pseudo_id = -pid;
     }
 #endif
-    if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV))
-       sv_setiv(GvSV(tmpgv), -(IV)w32_pseudo_id);
+    if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV)) {
+       SV *sv = GvSV(tmpgv);
+       SvREADONLY_off(sv);
+       sv_setiv(sv, -(IV)w32_pseudo_id);
+       SvREADONLY_on(sv);
+    }
     hv_clear(PL_pidstatus);
 
     /* push a zero on the stack (we are the child) */
@@ -1744,9 +1762,11 @@ restart:
        JMPENV_POP;
 
        /* XXX hack to avoid perl_destruct() freeing optree */
+        win32_checkTLS(my_perl);
        PL_main_root = Nullop;
     }
 
+    win32_checkTLS(my_perl);
     /* close the std handles to avoid fd leaks */
     {
        do_close(gv_fetchpv("STDIN", TRUE, SVt_PVIO), FALSE);
@@ -1755,7 +1775,9 @@ restart:
     }
 
     /* destroy everything (waits for any pseudo-forked children) */
+    win32_checkTLS(my_perl);
     perl_destruct(my_perl);
+    win32_checkTLS(my_perl);
     perl_free(my_perl);
 
 #ifdef PERL_SYNC_FORK
@@ -1792,6 +1814,7 @@ PerlProcFork(struct IPerlProc* piPerl)
                                                 h->m_pHostperlProc
                                                 );
     new_perl->Isys_intern.internal_host = h;
+    h->host_perl = new_perl;
 #  ifdef PERL_SYNC_FORK
     id = win32_start_child((LPVOID)new_perl);
     PERL_SET_THX(aTHX);
@@ -1932,6 +1955,7 @@ CPerlHost::CPerlHost(void)
 
     m_dwEnvCount = 0;
     m_lppEnvList = NULL;
+    m_bTopLevel = TRUE;
 
     CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
     CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
@@ -1981,6 +2005,7 @@ CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
 
     m_dwEnvCount = 0;
     m_lppEnvList = NULL;
+    m_bTopLevel = FALSE;
 
     CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
     CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
@@ -2037,6 +2062,7 @@ CPerlHost::CPerlHost(CPerlHost& host)
 
     m_dwEnvCount = 0;
     m_lppEnvList = NULL;
+    m_bTopLevel = FALSE;
 
     /* duplicate environment info */
     LPSTR lpPtr;
@@ -2136,7 +2162,7 @@ compare(const void *arg1, const void *arg2)
            if(c1 != c2) {
                if(c1 < c2)
                    return -1; // string 1 < string 2
-       
+
                return 1; // string 1 > string 2
            }
        }
@@ -2264,7 +2290,7 @@ CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
                lpStr += nLength;
                lpEnvPtr += nLength;
            }
-           else {      
+           else {
                // determine which string to copy next
                compVal = compare(&lpEnvPtr, &lpLocalEnv);
                if(compVal < 0) {
@@ -2351,7 +2377,7 @@ CPerlHost::Clearenv(void)
            ch = *++lpPtr;
            *lpPtr = 0;
            Add(lpStr);
-           if (!w32_pseudo_id)
+           if (m_bTopLevel)
                (void)win32_putenv(lpStr);
            *lpPtr = ch;
        }
@@ -2366,7 +2392,7 @@ char*
 CPerlHost::Getenv(const char *varname)
 {
     dTHX;
-    if (w32_pseudo_id) {
+    if (!m_bTopLevel) {
        char *pEnv = Find(varname);
        if (pEnv && *pEnv)
            return pEnv;
@@ -2379,7 +2405,7 @@ CPerlHost::Putenv(const char *envstring)
 {
     dTHX;
     Add(envstring);
-    if (!w32_pseudo_id)
+    if (m_bTopLevel)
        return win32_putenv(envstring);
 
     return 0;