Re: [PATCH] Add "Camel" logo icon to perl.exe on Windows

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

diff --git a/win32/perlhost.h b/win32/perlhost.h
index 7a6fc43..3b6d11d 100644 (file)
--- a/win32/perlhost.h
+++ b/win32/perlhost.h
@@ -22,7 +22,6 @@ 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);
 END_EXTERN_C
 
 class CPerlHost
@@ -216,9 +215,7 @@ protected:
     static long num_hosts;
 public:
     inline  int LastHost(void) { return num_hosts == 1L; };
-#ifdef CHECK_HOST_INTERP
     struct interpreter *host_perl;
-#endif
 };
 
 long CPerlHost::num_hosts = 0L;
@@ -227,7 +224,7 @@ extern "C" void win32_checkTLS(struct interpreter *host_perl);
 
 #define STRUCT2RAWPTR(x, y) (CPerlHost*)(((LPBYTE)x)-offsetof(CPerlHost, y))
 #ifdef CHECK_HOST_INTERP
-inline CPerlHost* CheckInterp(CPerlHost *host) 
+inline CPerlHost* CheckInterp(CPerlHost *host)
 {
  win32_checkTLS(host->host_perl);
  return host;
@@ -244,12 +241,12 @@ inline CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl)
 
 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)
@@ -765,14 +762,14 @@ PerlStdIOVprintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format, va_lis
     return win32_vfprintf(pf, format, arglist);
 }
 
-long
+Off_t
 PerlStdIOTell(struct IPerlStdIO* piPerl, FILE* pf)
 {
     return win32_ftell(pf);
 }
 
 int
-PerlStdIOSeek(struct IPerlStdIO* piPerl, FILE* pf, off_t offset, int origin)
+PerlStdIOSeek(struct IPerlStdIO* piPerl, FILE* pf, Off_t offset, int origin)
 {
     return win32_fseek(pf, offset, origin);
 }
@@ -812,12 +809,12 @@ PerlStdIOInitOSExtras(struct IPerlStdIO* piPerl)
 }
 
 int
-PerlStdIOOpenOSfhandle(struct IPerlStdIO* piPerl, long osfhandle, int flags)
+PerlStdIOOpenOSfhandle(struct IPerlStdIO* piPerl, intptr_t osfhandle, int flags)
 {
     return win32_open_osfhandle(osfhandle, flags);
 }
 
-int
+intptr_t
 PerlStdIOGetOSfhandle(struct IPerlStdIO* piPerl, int filenum)
 {
     return win32_get_osfhandle(filenum);
@@ -942,9 +939,9 @@ PerlLIOChown(struct IPerlLIO* piPerl, const char *filename, uid_t owner, gid_t g
 }
 
 int
-PerlLIOChsize(struct IPerlLIO* piPerl, int handle, long size)
+PerlLIOChsize(struct IPerlLIO* piPerl, int handle, Off_t size)
 {
-    return chsize(handle, size);
+    return win32_chsize(handle, size);
 }
 
 int
@@ -972,7 +969,7 @@ PerlLIOFlock(struct IPerlLIO* piPerl, int fd, int oper)
 }
 
 int
-PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, struct stat *buffer)
+PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, Stat_t *buffer)
 {
     return win32_fstat(handle, buffer);
 }
@@ -995,14 +992,14 @@ PerlLIOLink(struct IPerlLIO* piPerl, const char*oldname, const char *newname)
     return win32_link(oldname, newname);
 }
 
-long
-PerlLIOLseek(struct IPerlLIO* piPerl, int handle, long offset, int origin)
+Off_t
+PerlLIOLseek(struct IPerlLIO* piPerl, int handle, Off_t offset, int origin)
 {
     return win32_lseek(handle, offset, origin);
 }
 
 int
-PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
+PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, Stat_t *buffer)
 {
     return win32_stat(path, buffer);
 }
@@ -1044,7 +1041,7 @@ PerlLIOSetmode(struct IPerlLIO* piPerl, int handle, int mode)
 }
 
 int
-PerlLIONameStat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer)
+PerlLIONameStat(struct IPerlLIO* piPerl, const char *path, Stat_t *buffer)
 {
     return win32_stat(path, buffer);
 }
@@ -1680,7 +1677,13 @@ 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);
+}
+
+int
+PerlProcGetTimeOfDay(struct IPerlProc* piPerl, struct timeval *t, void *z)
+{
+    return win32_gettimeofday(t, z);
 }
 
 #ifdef USE_ITHREADS
@@ -1771,9 +1774,9 @@ restart:
     win32_checkTLS(my_perl);
     /* 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);
+       do_close(PL_stdingv, FALSE);
+       do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO), FALSE); /* PL_stdoutgv - ISAGN */
+       do_close(PL_stderrgv, FALSE);
     }
 
     /* destroy everything (waits for any pseudo-forked children) */
@@ -1867,19 +1870,6 @@ PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr)
     win32_str_os_error(sv, dwErr);
 }
 
-BOOL
-PerlProcDoCmd(struct IPerlProc* piPerl, char *cmd)
-{
-    do_spawn2(cmd, EXECF_EXEC);
-    return FALSE;
-}
-
-int
-PerlProcSpawn(struct IPerlProc* piPerl, char* cmds)
-{
-    return do_spawn2(cmds, EXECF_SPAWN);
-}
-
 int
 PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
 {
@@ -1887,12 +1877,6 @@ PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const c
 }
 
 int
-PerlProcASpawn(struct IPerlProc* piPerl, void *vreally, void **vmark, void **vsp)
-{
-    return do_aspawn(vreally, vmark, vsp);
-}
-
-int
 PerlProcLastHost(struct IPerlProc* piPerl)
 {
  dTHX;
@@ -1931,12 +1915,10 @@ struct IPerlProc perlProc =
     PerlProcGetpid,
     PerlProcDynaLoader,
     PerlProcGetOSError,
-    PerlProcDoCmd,
-    PerlProcSpawn,
     PerlProcSpawnvp,
-    PerlProcASpawn,
     PerlProcLastHost,
-    PerlProcPopenList
+    PerlProcPopenList,
+    PerlProcGetTimeOfDay
 };
 
 
@@ -2075,7 +2057,7 @@ CPerlHost::CPerlHost(CPerlHost& host)
 
 CPerlHost::~CPerlHost(void)
 {
-//  Reset();
+    Reset();
     InterlockedDecrement(&num_hosts);
     delete m_pvDir;
     m_pVMemParse->Release();
@@ -2136,6 +2118,8 @@ lookup(const void *arg1, const void *arg2)
 LPSTR*
 CPerlHost::Lookup(LPCSTR lpStr)
 {
+    if (!lpStr)
+       return NULL;
     return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
 }
 
@@ -2164,7 +2148,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
            }
        }
@@ -2187,20 +2171,24 @@ CPerlHost::Add(LPCSTR lpStr)
 
     // replacing ?
     lpPtr = Lookup(szBuffer);
-    if(lpPtr != NULL) {
-       Renew(*lpPtr, length, char);
+    if (lpPtr != NULL) {
+       // must allocate things via host memory allocation functions 
+       // rather than perl's Renew() et al, as the perl interpreter
+       // may either not be initialized enough when we allocate these,
+       // or may already be dead when we go to free these
+       *lpPtr = (char*)Realloc(*lpPtr, length * sizeof(char));
        strcpy(*lpPtr, lpStr);
     }
     else {
-       ++m_dwEnvCount;
-       Renew(m_lppEnvList, m_dwEnvCount, LPSTR);
-       New(1, m_lppEnvList[m_dwEnvCount-1], length, char);
-       if(m_lppEnvList[m_dwEnvCount-1] != NULL) {
-           strcpy(m_lppEnvList[m_dwEnvCount-1], lpStr);
-           qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
+       m_lppEnvList = (LPSTR*)Realloc(m_lppEnvList, (m_dwEnvCount+1) * sizeof(LPSTR));
+       if (m_lppEnvList) {
+           m_lppEnvList[m_dwEnvCount] = (char*)Malloc(length * sizeof(char));
+           if (m_lppEnvList[m_dwEnvCount] != NULL) {
+               strcpy(m_lppEnvList[m_dwEnvCount], lpStr);
+               ++m_dwEnvCount;
+               qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare);
+           }
        }
-       else
-           --m_dwEnvCount;
     }
 }
 
@@ -2292,7 +2280,7 @@ CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
                lpStr += nLength;
                lpEnvPtr += nLength;
            }
-           else {      
+           else {
                // determine which string to copy next
                compVal = compare(&lpEnvPtr, &lpLocalEnv);
                if(compVal < 0) {
@@ -2343,11 +2331,13 @@ CPerlHost::Reset(void)
     dTHX;
     if(m_lppEnvList != NULL) {
        for(DWORD index = 0; index < m_dwEnvCount; ++index) {
-           Safefree(m_lppEnvList[index]);
+           Free(m_lppEnvList[index]);
            m_lppEnvList[index] = NULL;
        }
     }
     m_dwEnvCount = 0;
+    Free(m_lppEnvList);
+    m_lppEnvList = NULL;
 }
 
 void
@@ -2436,4 +2426,3 @@ CPerlHost::Chdir(const char *dirname)
 }
 
 #endif /* ___PerlHost_H___ */
-