Bump version to5.17.11

[perl5.git] / win32 / perlhost.h

diff --git a/win32/perlhost.h b/win32/perlhost.h
index 61f8765..265328b 100644 (file)
--- a/win32/perlhost.h
+++ b/win32/perlhost.h
@@ -26,11 +26,10 @@
 #endif
 
 START_EXTERN_C
-extern char *          g_win32_get_privlib(const char *pl, STRLEN *const len);
-extern char *          g_win32_get_sitelib(const char *pl, STRLEN *const len);
-extern char *          g_win32_get_vendorlib(const char *pl,
-                                             STRLEN *const len);
-extern char *          g_getlogin(void);
+extern char *  g_win32_get_privlib(const char *pl, STRLEN *const len);
+extern char *  g_win32_get_sitelib(const char *pl, STRLEN *const len);
+extern char *  g_win32_get_vendorlib(const char *pl, STRLEN *const len);
+extern char *  g_getlogin(void);
 END_EXTERN_C
 
 class CPerlHost
@@ -663,19 +662,19 @@ PerlStdIOGetPtr(struct IPerlStdIO* piPerl, FILE* pf)
 }
 
 char*
-PerlStdIOGets(struct IPerlStdIO* piPerl, FILE* pf, char* s, int n)
+PerlStdIOGets(struct IPerlStdIO* piPerl, char* s, int n, FILE* pf)
 {
     return win32_fgets(s, n, pf);
 }
 
 int
-PerlStdIOPutc(struct IPerlStdIO* piPerl, FILE* pf, int c)
+PerlStdIOPutc(struct IPerlStdIO* piPerl, int c, FILE* pf)
 {
     return win32_fputc(c, pf);
 }
 
 int
-PerlStdIOPuts(struct IPerlStdIO* piPerl, FILE* pf, const char *s)
+PerlStdIOPuts(struct IPerlStdIO* piPerl, const char *s, FILE* pf)
 {
     return win32_fputs(s, pf);
 }
@@ -840,21 +839,6 @@ PerlStdIOFdupopen(struct IPerlStdIO* piPerl, FILE* pf)
     int fileno = win32_dup(win32_fileno(pf));
 
     /* open the file in the same mode */
-#ifdef __BORLANDC__
-    if((pf)->flags & _F_READ) {
-       mode[0] = 'r';
-       mode[1] = 0;
-    }
-    else if((pf)->flags & _F_WRIT) {
-       mode[0] = 'a';
-       mode[1] = 0;
-    }
-    else if((pf)->flags & _F_RDWR) {
-       mode[0] = 'r';
-       mode[1] = '+';
-       mode[2] = 0;
-    }
-#else
     if((pf)->_flag & _IOREAD) {
        mode[0] = 'r';
        mode[1] = 0;
@@ -868,7 +852,6 @@ PerlStdIOFdupopen(struct IPerlStdIO* piPerl, FILE* pf)
        mode[1] = '+';
        mode[2] = 0;
     }
-#endif
 
     /* it appears that the binmode is attached to the
      * file descriptor so binmode files will be handled
@@ -1004,7 +987,7 @@ PerlLIOIOCtl(struct IPerlLIO* piPerl, int i, unsigned int u, char *data)
 int
 PerlLIOIsatty(struct IPerlLIO* piPerl, int fd)
 {
-    return isatty(fd);
+    return win32_isatty(fd);
 }
 
 int
@@ -1295,8 +1278,7 @@ PerlSockGethostbyname(struct IPerlSock* piPerl, const char* name)
 struct hostent*
 PerlSockGethostent(struct IPerlSock* piPerl)
 {
-    dTHX;
-    Perl_croak(aTHX_ "gethostent not implemented!\n");
+    win32_croak_not_implemented("gethostent");
     return NULL;
 }
 
@@ -1551,13 +1533,13 @@ PerlProcCrypt(struct IPerlProc* piPerl, const char* clear, const char* salt)
     return win32_crypt(clear, salt);
 }
 
-void
+PERL_CALLCONV_NO_RET void
 PerlProcExit(struct IPerlProc* piPerl, int status)
 {
     exit(status);
 }
 
-void
+PERL_CALLCONV_NO_RET void
 PerlProc_Exit(struct IPerlProc* piPerl, int status)
 {
     _exit(status);
@@ -1710,7 +1692,6 @@ static THREAD_RET_TYPE
 win32_start_child(LPVOID arg)
 {
     PerlInterpreter *my_perl = (PerlInterpreter*)arg;
-    GV *tmpgv;
     int status;
     HWND parent_message_hwnd;
 #ifdef PERL_SYNC_FORK
@@ -1722,23 +1703,11 @@ win32_start_child(LPVOID arg)
     PERL_SET_THX(my_perl);
     win32_checkTLS(my_perl);
 
-    /* set $$ to pseudo id */
 #ifdef PERL_SYNC_FORK
     w32_pseudo_id = id;
 #else
     w32_pseudo_id = GetCurrentThreadId();
-    if (IsWin95()) {
-       int pid = (int)w32_pseudo_id;
-       if (pid < 0)
-           w32_pseudo_id = -pid;
-    }
 #endif
-    if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV)) {
-       SV *sv = GvSV(tmpgv);
-       SvREADONLY_off(sv);
-       sv_setiv(sv, -(IV)w32_pseudo_id);
-       SvREADONLY_on(sv);
-    }
 #ifdef PERL_USES_PL_PIDSTATUS    
     hv_clear(PL_pidstatus);
 #endif    
@@ -1769,6 +1738,16 @@ restart:
        switch (status) {
        case 0:
            CALLRUNOPS(aTHX);
+            /* We may have additional unclosed scopes if fork() was called
+             * from within a BEGIN block.  See perlfork.pod for more details.
+             * We cannot clean up these other scopes because they belong to a
+             * different interpreter, but we also cannot leave PL_scopestack_ix
+             * dangling because that can trigger an assertion in perl_destruct().
+             */
+            if (PL_scopestack_ix > oldscope) {
+                PL_scopestack[oldscope-1] = PL_scopestack[PL_scopestack_ix-1];
+                PL_scopestack_ix = oldscope;
+            }
            status = 0;
            break;
        case 2:
@@ -1776,6 +1755,10 @@ restart:
                LEAVE;
            FREETMPS;
            PL_curstash = PL_defstash;
+           if (PL_curstash != PL_defstash) {
+               SvREFCNT_dec(PL_curstash);
+               PL_curstash = (HV *)SvREFCNT_inc(PL_defstash);
+           }
            if (PL_endav && !PL_minus_c)
                call_list(oldscope, PL_endav);
            status = STATUS_EXIT;
@@ -1824,8 +1807,8 @@ restart:
 int
 PerlProcFork(struct IPerlProc* piPerl)
 {
-    dTHX;
 #ifdef USE_ITHREADS
+    dTHX;
     DWORD id;
     HANDLE handle;
     CPerlHost *h;
@@ -1870,18 +1853,14 @@ PerlProcFork(struct IPerlProc* piPerl)
        errno = EAGAIN;
        return -1;
     }
-    if (IsWin95()) {
-       int pid = (int)id;
-       if (pid < 0)
-           id = -pid;
-    }
     w32_pseudo_child_handles[w32_num_pseudo_children] = handle;
     w32_pseudo_child_pids[w32_num_pseudo_children] = id;
+    w32_pseudo_child_sigterm[w32_num_pseudo_children] = 0;
     ++w32_num_pseudo_children;
 #  endif
     return -(int)id;
 #else
-    Perl_croak(aTHX_ "fork() not implemented!\n");
+    win32_croak_not_implemented("fork()");
     return -1;
 #endif /* USE_ITHREADS */
 }
@@ -1913,6 +1892,8 @@ PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const c
 int
 PerlProcLastHost(struct IPerlProc* piPerl)
 {
+ /* this dTHX is unused in an optimized build since CPerlHost::num_hosts
+    is a static */
  dTHX;
  CPerlHost *h = (CPerlHost*)w32_internal_host;
  return h->LastHost();
@@ -2197,7 +2178,6 @@ compare(const void *arg1, const void *arg2)
 void
 CPerlHost::Add(LPCSTR lpStr)
 {
-    dTHX;
     char szBuffer[1024];
     LPSTR *lpPtr;
     int index, length = strlen(lpStr)+1;
@@ -2244,14 +2224,12 @@ CPerlHost::CalculateEnvironmentSpace(void)
 void
 CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr)
 {
-    dTHX;
     Safefree(lpStr);
 }
 
 char*
 CPerlHost::GetChildDir(void)
 {
-    dTHX;
     char* ptr;
     size_t length;
 
@@ -2268,20 +2246,18 @@ CPerlHost::GetChildDir(void)
 void
 CPerlHost::FreeChildDir(char* pStr)
 {
-    dTHX;
     Safefree(pStr);
 }
 
 LPSTR
 CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
 {
-    dTHX;
     LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr;
     DWORD dwSize, dwEnvIndex;
     int nLength, compVal;
 
     // get the process environment strings
-    lpAllocPtr = lpTmp = (LPSTR)GetEnvironmentStrings();
+    lpAllocPtr = lpTmp = (LPSTR)win32_getenvironmentstrings();
 
     // step over current directory stuff
     while(*lpTmp == '=')
@@ -2357,7 +2333,7 @@ CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
     }
 
     // release the process environment strings
-    FreeEnvironmentStrings(lpAllocPtr);
+    win32_freeenvironmentstrings(lpAllocPtr);
 
     return lpPtr;
 }
@@ -2365,7 +2341,6 @@ CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
 void
 CPerlHost::Reset(void)
 {
-    dTHX;
     if(m_lppEnvList != NULL) {
        for(DWORD index = 0; index < m_dwEnvCount; ++index) {
            Free(m_lppEnvList[index]);
@@ -2380,7 +2355,6 @@ CPerlHost::Reset(void)
 void
 CPerlHost::Clearenv(void)
 {
-    dTHX;
     char ch;
     LPSTR lpPtr, lpStr, lpEnvPtr;
     if (m_lppEnvList != NULL) {
@@ -2394,7 +2368,7 @@ CPerlHost::Clearenv(void)
     }
 
     /* get the process environment strings */
-    lpStr = lpEnvPtr = (LPSTR)GetEnvironmentStrings();
+    lpStr = lpEnvPtr = (LPSTR)win32_getenvironmentstrings();
 
     /* step over current directory stuff */
     while(*lpStr == '=')
@@ -2413,14 +2387,13 @@ CPerlHost::Clearenv(void)
        lpStr += strlen(lpStr) + 1;
     }
 
-    FreeEnvironmentStrings(lpEnvPtr);
+    win32_freeenvironmentstrings(lpEnvPtr);
 }
 
 
 char*
 CPerlHost::Getenv(const char *varname)
 {
-    dTHX;
     if (!m_bTopLevel) {
        char *pEnv = Find(varname);
        if (pEnv && *pEnv)
@@ -2432,7 +2405,6 @@ CPerlHost::Getenv(const char *varname)
 int
 CPerlHost::Putenv(const char *envstring)
 {
-    dTHX;
     Add(envstring);
     if (m_bTopLevel)
        return win32_putenv(envstring);
@@ -2443,7 +2415,6 @@ CPerlHost::Putenv(const char *envstring)
 int
 CPerlHost::Chdir(const char *dirname)
 {
-    dTHX;
     int ret;
     if (!dirname) {
        errno = ENOENT;