This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Revert #29307. It doesn't fix the XXX after all. Using "$(shell @type )"
[perl5.git] / win32 / perlhost.h
index 719d82a..fe026dd 100644 (file)
@@ -1,36 +1,32 @@
 /* perlhost.h
  *
- * (c) 1999 Microsoft Corporation. All rights reserved. 
+ * (c) 1999 Microsoft Corporation. All rights reserved.
  * Portions (c) 1999 ActiveState Tool Corp, http://www.ActiveState.com/
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
  */
 
+#ifndef UNDER_CE
+#define CHECK_HOST_INTERP
+#endif
+
 #ifndef ___PerlHost_H___
 #define ___PerlHost_H___
 
+#ifndef UNDER_CE
 #include <signal.h>
+#endif
 #include "iperlsys.h"
 #include "vmem.h"
 #include "vdir.h"
 
-#if !defined(PERL_OBJECT)
 START_EXTERN_C
-#endif
 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)
 END_EXTERN_C
-#endif
-
-#ifdef PERL_OBJECT
-extern int             g_do_aspawn(void *vreally, void **vmark, void **vsp);
-#define do_aspawn      g_do_aspawn
-#endif
 
 class CPerlHost
 {
@@ -61,6 +57,7 @@ public:
     void PerlDestroy(void);
 
 /* IPerlMem */
+    /* Locks provided but should be unnecessary as this is private pool */
     inline void* Malloc(size_t size) { return m_pVMem->Malloc(size); };
     inline void* Realloc(void* ptr, size_t size) { return m_pVMem->Realloc(ptr, size); };
     inline void Free(void* ptr) { m_pVMem->Free(ptr); };
@@ -77,12 +74,32 @@ public:
     inline int IsLocked(void) { return m_pVMem->IsLocked(); };
 
 /* IPerlMemShared */
+    /* Locks used to serialize access to the pool */
+    inline void GetLockShared(void) { m_pVMemShared->GetLock(); };
+    inline void FreeLockShared(void) { m_pVMemShared->FreeLock(); };
+    inline int IsLockedShared(void) { return m_pVMemShared->IsLocked(); };
     inline void* MallocShared(size_t size)
     {
-       return m_pVMemShared->Malloc(size);
+       void *result;
+       GetLockShared();
+       result = m_pVMemShared->Malloc(size);
+       FreeLockShared();
+       return result;
+    };
+    inline void* ReallocShared(void* ptr, size_t size)
+    {
+       void *result;
+       GetLockShared();
+       result = m_pVMemShared->Realloc(ptr, size);
+       FreeLockShared();
+       return result;
+    };
+    inline void FreeShared(void* ptr)
+    {
+       GetLockShared();
+       m_pVMemShared->Free(ptr);
+       FreeLockShared();
     };
-    inline void* ReallocShared(void* ptr, size_t size) { return m_pVMemShared->Realloc(ptr, size); };
-    inline void FreeShared(void* ptr) { m_pVMemShared->Free(ptr); };
     inline void* CallocShared(size_t num, size_t size)
     {
        size_t count = num*size;
@@ -91,11 +108,14 @@ public:
            ZeroMemory(lpVoid, count);
        return lpVoid;
     };
-    inline void GetLockShared(void) { m_pVMem->GetLock(); };
-    inline void FreeLockShared(void) { m_pVMem->FreeLock(); };
-    inline int IsLockedShared(void) { return m_pVMem->IsLocked(); };
 
 /* IPerlMemParse */
+    /* Assume something else is using locks to mangaging serialize
+       on a batch basis
+     */
+    inline void GetLockParse(void) { m_pVMemParse->GetLock(); };
+    inline void FreeLockParse(void) { m_pVMemParse->FreeLock(); };
+    inline int IsLockedParse(void) { return m_pVMemParse->IsLocked(); };
     inline void* MallocParse(size_t size) { return m_pVMemParse->Malloc(size); };
     inline void* ReallocParse(void* ptr, size_t size) { return m_pVMemParse->Realloc(ptr, size); };
     inline void FreeParse(void* ptr) { m_pVMemParse->Free(ptr); };
@@ -107,9 +127,6 @@ public:
            ZeroMemory(lpVoid, count);
        return lpVoid;
     };
-    inline void GetLockParse(void) { m_pVMem->GetLock(); };
-    inline void FreeLockParse(void) { m_pVMem->FreeLock(); };
-    inline int IsLockedParse(void) { return m_pVMem->IsLocked(); };
 
 /* IPerlEnv */
     char *Getenv(const char *varname);
@@ -198,29 +215,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)
@@ -506,7 +536,7 @@ PerlEnvGetChildIO(struct IPerlEnv* piPerl, child_IO_table* ptr)
     win32_get_child_IO(ptr);
 }
 
-struct IPerlEnv perlEnv = 
+struct IPerlEnv perlEnv =
 {
     PerlEnvGetenv,
     PerlEnvPutenv,
@@ -736,14 +766,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);
 }
@@ -783,12 +813,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);
@@ -797,6 +827,7 @@ PerlStdIOGetOSfhandle(struct IPerlStdIO* piPerl, int filenum)
 FILE*
 PerlStdIOFdupopen(struct IPerlStdIO* piPerl, FILE* pf)
 {
+#ifndef UNDER_CE
     FILE* pfdup;
     fpos_t pos;
     char mode[3];
@@ -833,7 +864,7 @@ PerlStdIOFdupopen(struct IPerlStdIO* piPerl, FILE* pf)
     }
 #endif
 
-    /* it appears that the binmode is attached to the 
+    /* it appears that the binmode is attached to the
      * file descriptor so binmode files will be handled
      * correctly
      */
@@ -844,9 +875,12 @@ PerlStdIOFdupopen(struct IPerlStdIO* piPerl, FILE* pf)
        fsetpos(pfdup, &pos);
     }
     return pfdup;
+#else
+    return 0;
+#endif
 }
 
-struct IPerlStdIO perlStdIO = 
+struct IPerlStdIO perlStdIO =
 {
     PerlStdIOStdin,
     PerlStdIOStdout,
@@ -913,9 +947,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
@@ -943,7 +977,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);
 }
@@ -966,14 +1000,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);
 }
@@ -1015,7 +1049,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);
 }
@@ -1039,7 +1073,7 @@ PerlLIOUnlink(struct IPerlLIO* piPerl, const char *filename)
 }
 
 int
-PerlLIOUtime(struct IPerlLIO* piPerl, char *filename, struct utimbuf *times)
+PerlLIOUtime(struct IPerlLIO* piPerl, const char *filename, struct utimbuf *times)
 {
     return win32_utime(filename, times);
 }
@@ -1110,7 +1144,7 @@ PerlDirClose(struct IPerlDir* piPerl, DIR *dirp)
 }
 
 DIR*
-PerlDirOpen(struct IPerlDir* piPerl, char *filename)
+PerlDirOpen(struct IPerlDir* piPerl, const char *filename)
 {
     return win32_opendir(filename);
 }
@@ -1248,7 +1282,7 @@ PerlSockGethostbyname(struct IPerlSock* piPerl, const char* name)
 struct hostent*
 PerlSockGethostent(struct IPerlSock* piPerl)
 {
-    dTHXo;
+    dTHX;
     Perl_croak(aTHX_ "gethostent not implemented!\n");
     return NULL;
 }
@@ -1423,9 +1457,7 @@ PerlSockSocket(struct IPerlSock* piPerl, int af, int type, int protocol)
 int
 PerlSockSocketpair(struct IPerlSock* piPerl, int domain, int type, int protocol, int* fds)
 {
-    dTHXo;
-    Perl_croak(aTHX_ "socketpair not implemented!\n");
-    return 0;
+    return Perl_my_socketpair(domain, type, protocol, fds);
 }
 
 int
@@ -1575,7 +1607,7 @@ PerlProcKill(struct IPerlProc* piPerl, int pid, int sig)
 int
 PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig)
 {
-    dTHXo;
+    dTHX;
     Perl_croak(aTHX_ "killpg not implemented!\n");
     return 0;
 }
@@ -1589,11 +1621,19 @@ PerlProcPauseProc(struct IPerlProc* piPerl)
 PerlIO*
 PerlProcPopen(struct IPerlProc* piPerl, const char *command, const char *mode)
 {
-    dTHXo;
+    dTHX;
     PERL_FLUSHALL_FOR_CHILD;
     return win32_popen(command, mode);
 }
 
+PerlIO*
+PerlProcPopenList(struct IPerlProc* piPerl, const char *mode, IV narg, SV **args)
+{
+    dTHX;
+    PERL_FLUSHALL_FOR_CHILD;
+    return win32_popenlist(mode, narg, args);
+}
+
 int
 PerlProcPclose(struct IPerlProc* piPerl, PerlIO *stream)
 {
@@ -1645,7 +1685,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
@@ -1655,9 +1701,7 @@ win32_start_child(LPVOID arg)
     PerlInterpreter *my_perl = (PerlInterpreter*)arg;
     GV *tmpgv;
     int status;
-#ifdef PERL_OBJECT
-    CPerlObj *pPerl = (CPerlObj*)my_perl;
-#endif
+    HWND parent_message_hwnd;
 #ifdef PERL_SYNC_FORK
     static long sync_fork_id = 0;
     long id = ++sync_fork_id;
@@ -1665,6 +1709,7 @@ win32_start_child(LPVOID arg)
 
 
     PERL_SET_THX(my_perl);
+    win32_checkTLS(my_perl);
 
     /* set $$ to pseudo id */
 #ifdef PERL_SYNC_FORK
@@ -1677,9 +1722,21 @@ 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);
+    }
+#ifdef PERL_USES_PL_PIDSTATUS    
     hv_clear(PL_pidstatus);
+#endif    
+
+    /* create message window and tell parent about it */
+    parent_message_hwnd = w32_message_hwnd;
+    w32_message_hwnd = win32_create_message_window();
+    if (parent_message_hwnd != NULL)
+        PostMessage(parent_message_hwnd, WM_USER_MESSAGE, w32_pseudo_id, (LONG)w32_message_hwnd);
 
     /* push a zero on the stack (we are the child) */
     {
@@ -1710,7 +1767,7 @@ restart:
            PL_curstash = PL_defstash;
            if (PL_endav && !PL_minus_c)
                call_list(oldscope, PL_endav);
-           status = STATUS_NATIVE_EXPORT;
+           status = STATUS_EXIT;
            break;
        case 3:
            if (PL_restartop) {
@@ -1727,18 +1784,22 @@ 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);
-       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) */
+    win32_checkTLS(my_perl);
     perl_destruct(my_perl);
+    win32_checkTLS(my_perl);
     perl_free(my_perl);
 
 #ifdef PERL_SYNC_FORK
@@ -1752,7 +1813,7 @@ restart:
 int
 PerlProcFork(struct IPerlProc* piPerl)
 {
-    dTHXo;
+    dTHX;
 #ifdef USE_ITHREADS
     DWORD id;
     HANDLE handle;
@@ -1763,7 +1824,7 @@ PerlProcFork(struct IPerlProc* piPerl)
        return -1;
     }
     h = new CPerlHost(*(CPerlHost*)w32_internal_host);
-    PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHXo, 1,
+    PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHX, 1,
                                                 h->m_pHostperlMem,
                                                 h->m_pHostperlMemShared,
                                                 h->m_pHostperlMemParse,
@@ -1775,10 +1836,16 @@ 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(aTHXo);
+    PERL_SET_THX(aTHX);
 #  else
+    if (w32_message_hwnd == INVALID_HANDLE_VALUE)
+        w32_message_hwnd = win32_create_message_window();
+    new_perl->Isys_intern.message_hwnd = w32_message_hwnd;
+    w32_pseudo_child_message_hwnds[w32_num_pseudo_children] =
+        (w32_message_hwnd == NULL) ? (HWND)NULL : (HWND)INVALID_HANDLE_VALUE;
 #    ifdef USE_RTL_THREAD_API
     handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child,
                                    (void*)new_perl, 0, (unsigned*)&id);
@@ -1786,7 +1853,7 @@ PerlProcFork(struct IPerlProc* piPerl)
     handle = CreateThread(NULL, 0, win32_start_child,
                          (LPVOID)new_perl, 0, &id);
 #    endif
-    PERL_SET_THX(aTHXo);       /* XXX perl_clone*() set TLS */
+    PERL_SET_THX(aTHX);        /* XXX perl_clone*() set TLS */
     if (!handle) {
        errno = EAGAIN;
        return -1;
@@ -1825,19 +1892,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)
 {
@@ -1845,15 +1899,9 @@ 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)
 {
- dTHXo;
+ dTHX;
  CPerlHost *h = (CPerlHost*)w32_internal_host;
  return h->LastHost();
 }
@@ -1889,11 +1937,10 @@ struct IPerlProc perlProc =
     PerlProcGetpid,
     PerlProcDynaLoader,
     PerlProcGetOSError,
-    PerlProcDoCmd,
-    PerlProcSpawn,
     PerlProcSpawnvp,
-    PerlProcASpawn,
-    PerlProcLastHost
+    PerlProcLastHost,
+    PerlProcPopenList,
+    PerlProcGetTimeOfDay
 };
 
 
@@ -1914,6 +1961,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));
@@ -1963,6 +2011,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));
@@ -2019,6 +2068,7 @@ CPerlHost::CPerlHost(CPerlHost& host)
 
     m_dwEnvCount = 0;
     m_lppEnvList = NULL;
+    m_bTopLevel = FALSE;
 
     /* duplicate environment info */
     LPSTR lpPtr;
@@ -2029,7 +2079,7 @@ CPerlHost::CPerlHost(CPerlHost& host)
 
 CPerlHost::~CPerlHost(void)
 {
-//  Reset();
+    Reset();
     InterlockedDecrement(&num_hosts);
     delete m_pvDir;
     m_pVMemParse->Release();
@@ -2090,6 +2140,12 @@ lookup(const void *arg1, const void *arg2)
 LPSTR*
 CPerlHost::Lookup(LPCSTR lpStr)
 {
+#ifdef UNDER_CE
+    if (!m_lppEnvList || !m_dwEnvCount)
+       return NULL;
+#endif
+    if (!lpStr)
+       return NULL;
     return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
 }
 
@@ -2118,7 +2174,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
            }
        }
@@ -2129,7 +2185,7 @@ compare(const void *arg1, const void *arg2)
 void
 CPerlHost::Add(LPCSTR lpStr)
 {
-    dTHXo;
+    dTHX;
     char szBuffer[1024];
     LPSTR *lpPtr;
     int index, length = strlen(lpStr)+1;
@@ -2141,20 +2197,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;
     }
 }
 
@@ -2172,17 +2232,17 @@ CPerlHost::CalculateEnvironmentSpace(void)
 void
 CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr)
 {
-    dTHXo;
+    dTHX;
     Safefree(lpStr);
 }
 
 char*
 CPerlHost::GetChildDir(void)
 {
-    dTHXo;
+    dTHX;
     int length;
     char* ptr;
-    New(0, ptr, MAX_PATH+1, char);
+    Newx(ptr, MAX_PATH+1, char);
     if(ptr) {
        m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
        length = strlen(ptr);
@@ -2197,14 +2257,14 @@ CPerlHost::GetChildDir(void)
 void
 CPerlHost::FreeChildDir(char* pStr)
 {
-    dTHXo;
+    dTHX;
     Safefree(pStr);
 }
 
 LPSTR
 CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
 {
-    dTHXo;
+    dTHX;
     LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr;
     DWORD dwSize, dwEnvIndex;
     int nLength, compVal;
@@ -2229,7 +2289,7 @@ CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
     // add the additional space used by changes made to the environment
     dwSize += CalculateEnvironmentSpace();
 
-    New(1, lpStr, dwSize, char);
+    Newx(lpStr, dwSize, char);
     lpPtr = lpStr;
     if(lpStr != NULL) {
        // build the local environment
@@ -2246,7 +2306,7 @@ CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
                lpStr += nLength;
                lpEnvPtr += nLength;
            }
-           else {      
+           else {
                // determine which string to copy next
                compVal = compare(&lpEnvPtr, &lpLocalEnv);
                if(compVal < 0) {
@@ -2272,11 +2332,12 @@ CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
 
        while(lpLocalEnv) {
            // still have environment overrides to add
-           // so copy the strings into place
-           strcpy(lpStr, lpLocalEnv);
-           nLength = strlen(lpLocalEnv) + 1;
-           lpStr += nLength;
-           lpEnvPtr += nLength;
+           // so copy the strings into place if not an override
+           char *ptr = strchr(lpLocalEnv, '=');
+           if(ptr && ptr[1]) {
+               strcpy(lpStr, lpLocalEnv);
+               lpStr += strlen(lpLocalEnv) + 1;
+           }
            lpLocalEnv = GetIndex(dwEnvIndex);
        }
 
@@ -2293,22 +2354,25 @@ CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
 void
 CPerlHost::Reset(void)
 {
-    dTHXo;
+    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
 CPerlHost::Clearenv(void)
 {
+    dTHX;
     char ch;
     LPSTR lpPtr, lpStr, lpEnvPtr;
-    if(m_lppEnvList != NULL) {
+    if (m_lppEnvList != NULL) {
        /* set every entry to an empty string */
        for(DWORD index = 0; index < m_dwEnvCount; ++index) {
            char* ptr = strchr(m_lppEnvList[index], '=');
@@ -2331,6 +2395,8 @@ CPerlHost::Clearenv(void)
            ch = *++lpPtr;
            *lpPtr = 0;
            Add(lpStr);
+           if (m_bTopLevel)
+               (void)win32_putenv(lpStr);
            *lpPtr = ch;
        }
        lpStr += strlen(lpStr) + 1;
@@ -2343,37 +2409,36 @@ CPerlHost::Clearenv(void)
 char*
 CPerlHost::Getenv(const char *varname)
 {
-    char* pEnv = Find(varname);
-    if(pEnv == NULL) {
-       pEnv = win32_getenv(varname);
-    }
-    else {
-       if(!*pEnv)
-           pEnv = 0;
+    dTHX;
+    if (!m_bTopLevel) {
+       char *pEnv = Find(varname);
+       if (pEnv && *pEnv)
+           return pEnv;
     }
-
-    return pEnv;
+    return win32_getenv(varname);
 }
 
 int
 CPerlHost::Putenv(const char *envstring)
 {
+    dTHX;
     Add(envstring);
+    if (m_bTopLevel)
+       return win32_putenv(envstring);
+
     return 0;
 }
 
 int
 CPerlHost::Chdir(const char *dirname)
 {
-    dTHXo;
+    dTHX;
     int ret;
-    if (USING_WIDE()) {
-       WCHAR wBuffer[MAX_PATH];
-       A2WHELPER(dirname, wBuffer, sizeof(wBuffer));
-       ret = m_pvDir->SetCurrentDirectoryW(wBuffer);
+    if (!dirname) {
+       errno = ENOENT;
+       return -1;
     }
-    else
-       ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
+    ret = m_pvDir->SetCurrentDirectoryA((char*)dirname);
     if(ret < 0) {
        errno = ENOENT;
     }