X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=win32%2Fperlhost.h;h=cd433fde89a4476646def1b00800b343658d2279;hb=f56fdd801e5b3d02170cb8e7692ffdc790f190a9;hp=78074955b44dfd32fb0943a87a04e40827956c3b;hpb=22d4bb9ccb8701e68f9243547d7e3a3c55f70908;p=p5sagit%2Fp5-mst-13.2.git diff --git a/win32/perlhost.h b/win32/perlhost.h index 7807495..cd433fd 100644 --- a/win32/perlhost.h +++ b/win32/perlhost.h @@ -1,6 +1,6 @@ /* 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 @@ -15,26 +15,18 @@ #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 { public: + /* Constructors */ CPerlHost(void); CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared, struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv, @@ -60,6 +52,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); }; @@ -76,12 +69,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; @@ -90,11 +103,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); }; @@ -106,9 +122,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); @@ -197,8 +210,13 @@ protected: DWORD m_dwEnvCount; LPSTR* m_lppEnvList; + static long num_hosts; +public: + inline int LastHost(void) { return num_hosts == 1L; }; }; +long CPerlHost::num_hosts = 0L; + #define STRUCT2PTR(x, y) (CPerlHost*)(((LPBYTE)x)-offsetof(CPerlHost, y)) @@ -500,7 +518,7 @@ PerlEnvGetChildIO(struct IPerlEnv* piPerl, child_IO_table* ptr) win32_get_child_IO(ptr); } -struct IPerlEnv perlEnv = +struct IPerlEnv perlEnv = { PerlEnvGetenv, PerlEnvPutenv, @@ -522,65 +540,65 @@ struct IPerlEnv perlEnv = #define IPERL2HOST(x) IPerlStdIO2Host(x) /* PerlStdIO */ -PerlIO* +FILE* PerlStdIOStdin(struct IPerlStdIO* piPerl) { - return (PerlIO*)win32_stdin(); + return win32_stdin(); } -PerlIO* +FILE* PerlStdIOStdout(struct IPerlStdIO* piPerl) { - return (PerlIO*)win32_stdout(); + return win32_stdout(); } -PerlIO* +FILE* PerlStdIOStderr(struct IPerlStdIO* piPerl) { - return (PerlIO*)win32_stderr(); + return win32_stderr(); } -PerlIO* +FILE* PerlStdIOOpen(struct IPerlStdIO* piPerl, const char *path, const char *mode) { - return (PerlIO*)win32_fopen(path, mode); + return win32_fopen(path, mode); } int -PerlStdIOClose(struct IPerlStdIO* piPerl, PerlIO* pf) +PerlStdIOClose(struct IPerlStdIO* piPerl, FILE* pf) { - return win32_fclose(((FILE*)pf)); + return win32_fclose((pf)); } int -PerlStdIOEof(struct IPerlStdIO* piPerl, PerlIO* pf) +PerlStdIOEof(struct IPerlStdIO* piPerl, FILE* pf) { - return win32_feof((FILE*)pf); + return win32_feof(pf); } int -PerlStdIOError(struct IPerlStdIO* piPerl, PerlIO* pf) +PerlStdIOError(struct IPerlStdIO* piPerl, FILE* pf) { - return win32_ferror((FILE*)pf); + return win32_ferror(pf); } void -PerlStdIOClearerr(struct IPerlStdIO* piPerl, PerlIO* pf) +PerlStdIOClearerr(struct IPerlStdIO* piPerl, FILE* pf) { - win32_clearerr((FILE*)pf); + win32_clearerr(pf); } int -PerlStdIOGetc(struct IPerlStdIO* piPerl, PerlIO* pf) +PerlStdIOGetc(struct IPerlStdIO* piPerl, FILE* pf) { - return win32_getc((FILE*)pf); + return win32_getc(pf); } char* -PerlStdIOGetBase(struct IPerlStdIO* piPerl, PerlIO* pf) +PerlStdIOGetBase(struct IPerlStdIO* piPerl, FILE* pf) { #ifdef FILE_base - FILE *f = (FILE*)pf; + FILE *f = pf; return FILE_base(f); #else return Nullch; @@ -588,10 +606,10 @@ PerlStdIOGetBase(struct IPerlStdIO* piPerl, PerlIO* pf) } int -PerlStdIOGetBufsiz(struct IPerlStdIO* piPerl, PerlIO* pf) +PerlStdIOGetBufsiz(struct IPerlStdIO* piPerl, FILE* pf) { #ifdef FILE_bufsiz - FILE *f = (FILE*)pf; + FILE *f = pf; return FILE_bufsiz(f); #else return (-1); @@ -599,10 +617,10 @@ PerlStdIOGetBufsiz(struct IPerlStdIO* piPerl, PerlIO* pf) } int -PerlStdIOGetCnt(struct IPerlStdIO* piPerl, PerlIO* pf) +PerlStdIOGetCnt(struct IPerlStdIO* piPerl, FILE* pf) { #ifdef USE_STDIO_PTR - FILE *f = (FILE*)pf; + FILE *f = pf; return FILE_cnt(f); #else return (-1); @@ -610,10 +628,10 @@ PerlStdIOGetCnt(struct IPerlStdIO* piPerl, PerlIO* pf) } char* -PerlStdIOGetPtr(struct IPerlStdIO* piPerl, PerlIO* pf) +PerlStdIOGetPtr(struct IPerlStdIO* piPerl, FILE* pf) { #ifdef USE_STDIO_PTR - FILE *f = (FILE*)pf; + FILE *f = pf; return FILE_ptr(f); #else return Nullch; @@ -621,150 +639,149 @@ PerlStdIOGetPtr(struct IPerlStdIO* piPerl, PerlIO* pf) } char* -PerlStdIOGets(struct IPerlStdIO* piPerl, PerlIO* pf, char* s, int n) +PerlStdIOGets(struct IPerlStdIO* piPerl, FILE* pf, char* s, int n) { - return win32_fgets(s, n, (FILE*)pf); + return win32_fgets(s, n, pf); } int -PerlStdIOPutc(struct IPerlStdIO* piPerl, PerlIO* pf, int c) +PerlStdIOPutc(struct IPerlStdIO* piPerl, FILE* pf, int c) { - return win32_fputc(c, (FILE*)pf); + return win32_fputc(c, pf); } int -PerlStdIOPuts(struct IPerlStdIO* piPerl, PerlIO* pf, const char *s) +PerlStdIOPuts(struct IPerlStdIO* piPerl, FILE* pf, const char *s) { - return win32_fputs(s, (FILE*)pf); + return win32_fputs(s, pf); } int -PerlStdIOFlush(struct IPerlStdIO* piPerl, PerlIO* pf) +PerlStdIOFlush(struct IPerlStdIO* piPerl, FILE* pf) { - return win32_fflush((FILE*)pf); + return win32_fflush(pf); } int -PerlStdIOUngetc(struct IPerlStdIO* piPerl, PerlIO* pf,int c) +PerlStdIOUngetc(struct IPerlStdIO* piPerl,int c, FILE* pf) { - return win32_ungetc(c, (FILE*)pf); + return win32_ungetc(c, pf); } int -PerlStdIOFileno(struct IPerlStdIO* piPerl, PerlIO* pf) +PerlStdIOFileno(struct IPerlStdIO* piPerl, FILE* pf) { - return win32_fileno((FILE*)pf); + return win32_fileno(pf); } -PerlIO* +FILE* PerlStdIOFdopen(struct IPerlStdIO* piPerl, int fd, const char *mode) { - return (PerlIO*)win32_fdopen(fd, mode); + return win32_fdopen(fd, mode); } -PerlIO* -PerlStdIOReopen(struct IPerlStdIO* piPerl, const char*path, const char*mode, PerlIO* pf) +FILE* +PerlStdIOReopen(struct IPerlStdIO* piPerl, const char*path, const char*mode, FILE* pf) { - return (PerlIO*)win32_freopen(path, mode, (FILE*)pf); + return win32_freopen(path, mode, (FILE*)pf); } SSize_t -PerlStdIORead(struct IPerlStdIO* piPerl, PerlIO* pf, void *buffer, Size_t size) +PerlStdIORead(struct IPerlStdIO* piPerl, void *buffer, Size_t size, Size_t count, FILE* pf) { - return win32_fread(buffer, 1, size, (FILE*)pf); + return win32_fread(buffer, size, count, pf); } SSize_t -PerlStdIOWrite(struct IPerlStdIO* piPerl, PerlIO* pf, const void *buffer, Size_t size) +PerlStdIOWrite(struct IPerlStdIO* piPerl, const void *buffer, Size_t size, Size_t count, FILE* pf) { - return win32_fwrite(buffer, 1, size, (FILE*)pf); + return win32_fwrite(buffer, size, count, pf); } void -PerlStdIOSetBuf(struct IPerlStdIO* piPerl, PerlIO* pf, char* buffer) +PerlStdIOSetBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer) { - win32_setbuf((FILE*)pf, buffer); + win32_setbuf(pf, buffer); } int -PerlStdIOSetVBuf(struct IPerlStdIO* piPerl, PerlIO* pf, char* buffer, int type, Size_t size) +PerlStdIOSetVBuf(struct IPerlStdIO* piPerl, FILE* pf, char* buffer, int type, Size_t size) { - return win32_setvbuf((FILE*)pf, buffer, type, size); + return win32_setvbuf(pf, buffer, type, size); } void -PerlStdIOSetCnt(struct IPerlStdIO* piPerl, PerlIO* pf, int n) +PerlStdIOSetCnt(struct IPerlStdIO* piPerl, FILE* pf, int n) { #ifdef STDIO_CNT_LVALUE - FILE *f = (FILE*)pf; + FILE *f = pf; FILE_cnt(f) = n; #endif } void -PerlStdIOSetPtrCnt(struct IPerlStdIO* piPerl, PerlIO* pf, char * ptr, int n) +PerlStdIOSetPtr(struct IPerlStdIO* piPerl, FILE* pf, char * ptr) { #ifdef STDIO_PTR_LVALUE - FILE *f = (FILE*)pf; + FILE *f = pf; FILE_ptr(f) = ptr; - FILE_cnt(f) = n; #endif } void -PerlStdIOSetlinebuf(struct IPerlStdIO* piPerl, PerlIO* pf) +PerlStdIOSetlinebuf(struct IPerlStdIO* piPerl, FILE* pf) { - win32_setvbuf((FILE*)pf, NULL, _IOLBF, 0); + win32_setvbuf(pf, NULL, _IOLBF, 0); } int -PerlStdIOPrintf(struct IPerlStdIO* piPerl, PerlIO* pf, const char *format,...) +PerlStdIOPrintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format,...) { va_list(arglist); va_start(arglist, format); - return win32_vfprintf((FILE*)pf, format, arglist); + return win32_vfprintf(pf, format, arglist); } int -PerlStdIOVprintf(struct IPerlStdIO* piPerl, PerlIO* pf, const char *format, va_list arglist) +PerlStdIOVprintf(struct IPerlStdIO* piPerl, FILE* pf, const char *format, va_list arglist) { - return win32_vfprintf((FILE*)pf, format, arglist); + return win32_vfprintf(pf, format, arglist); } long -PerlStdIOTell(struct IPerlStdIO* piPerl, PerlIO* pf) +PerlStdIOTell(struct IPerlStdIO* piPerl, FILE* pf) { - return win32_ftell((FILE*)pf); + return win32_ftell(pf); } int -PerlStdIOSeek(struct IPerlStdIO* piPerl, PerlIO* pf, off_t offset, int origin) +PerlStdIOSeek(struct IPerlStdIO* piPerl, FILE* pf, off_t offset, int origin) { - return win32_fseek((FILE*)pf, offset, origin); + return win32_fseek(pf, offset, origin); } void -PerlStdIORewind(struct IPerlStdIO* piPerl, PerlIO* pf) +PerlStdIORewind(struct IPerlStdIO* piPerl, FILE* pf) { - win32_rewind((FILE*)pf); + win32_rewind(pf); } -PerlIO* +FILE* PerlStdIOTmpfile(struct IPerlStdIO* piPerl) { - return (PerlIO*)win32_tmpfile(); + return win32_tmpfile(); } int -PerlStdIOGetpos(struct IPerlStdIO* piPerl, PerlIO* pf, Fpos_t *p) +PerlStdIOGetpos(struct IPerlStdIO* piPerl, FILE* pf, Fpos_t *p) { - return win32_fgetpos((FILE*)pf, p); + return win32_fgetpos(pf, p); } int -PerlStdIOSetpos(struct IPerlStdIO* piPerl, PerlIO* pf, const Fpos_t *p) +PerlStdIOSetpos(struct IPerlStdIO* piPerl, FILE* pf, const Fpos_t *p) { - return win32_fsetpos((FILE*)pf, p); + return win32_fsetpos(pf, p); } void PerlStdIOInit(struct IPerlStdIO* piPerl) @@ -789,59 +806,59 @@ PerlStdIOGetOSfhandle(struct IPerlStdIO* piPerl, int filenum) return win32_get_osfhandle(filenum); } -PerlIO* -PerlStdIOFdupopen(struct IPerlStdIO* piPerl, PerlIO* pf) +FILE* +PerlStdIOFdupopen(struct IPerlStdIO* piPerl, FILE* pf) { - PerlIO* pfdup; + FILE* pfdup; fpos_t pos; char mode[3]; - int fileno = win32_dup(win32_fileno((FILE*)pf)); + int fileno = win32_dup(win32_fileno(pf)); /* open the file in the same mode */ #ifdef __BORLANDC__ - if(((FILE*)pf)->flags & _F_READ) { + if((pf)->flags & _F_READ) { mode[0] = 'r'; mode[1] = 0; } - else if(((FILE*)pf)->flags & _F_WRIT) { + else if((pf)->flags & _F_WRIT) { mode[0] = 'a'; mode[1] = 0; } - else if(((FILE*)pf)->flags & _F_RDWR) { + else if((pf)->flags & _F_RDWR) { mode[0] = 'r'; mode[1] = '+'; mode[2] = 0; } #else - if(((FILE*)pf)->_flag & _IOREAD) { + if((pf)->_flag & _IOREAD) { mode[0] = 'r'; mode[1] = 0; } - else if(((FILE*)pf)->_flag & _IOWRT) { + else if((pf)->_flag & _IOWRT) { mode[0] = 'a'; mode[1] = 0; } - else if(((FILE*)pf)->_flag & _IORW) { + else if((pf)->_flag & _IORW) { mode[0] = 'r'; mode[1] = '+'; mode[2] = 0; } #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 */ - pfdup = (PerlIO*)win32_fdopen(fileno, mode); + pfdup = win32_fdopen(fileno, mode); /* move the file pointer to the same position */ - if (!fgetpos((FILE*)pf, &pos)) { - fsetpos((FILE*)pfdup, &pos); + if (!fgetpos(pf, &pos)) { + fsetpos(pfdup, &pos); } return pfdup; } -struct IPerlStdIO perlStdIO = +struct IPerlStdIO perlStdIO = { PerlStdIOStdin, PerlStdIOStdout, @@ -869,7 +886,7 @@ struct IPerlStdIO perlStdIO = PerlStdIOSetBuf, PerlStdIOSetVBuf, PerlStdIOSetCnt, - PerlStdIOSetPtrCnt, + PerlStdIOSetPtr, PerlStdIOSetlinebuf, PerlStdIOPrintf, PerlStdIOVprintf, @@ -1243,7 +1260,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; } @@ -1418,7 +1435,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; + dTHX; Perl_croak(aTHX_ "socketpair not implemented!\n"); return 0; } @@ -1570,7 +1587,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; } @@ -1584,15 +1601,23 @@ PerlProcPauseProc(struct IPerlProc* piPerl) PerlIO* PerlProcPopen(struct IPerlProc* piPerl, const char *command, const char *mode) { - dTHXo; + dTHX; PERL_FLUSHALL_FOR_CHILD; - return (PerlIO*)win32_popen(command, mode); + 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) { - return win32_pclose((FILE*)stream); + return win32_pclose(stream); } int @@ -1650,9 +1675,6 @@ win32_start_child(LPVOID arg) PerlInterpreter *my_perl = (PerlInterpreter*)arg; GV *tmpgv; int status; -#ifdef PERL_OBJECT - CPerlObj *pPerl = (CPerlObj*)my_perl; -#endif #ifdef PERL_SYNC_FORK static long sync_fork_id = 0; long id = ++sync_fork_id; @@ -1678,7 +1700,7 @@ win32_start_child(LPVOID arg) /* push a zero on the stack (we are the child) */ { - djSP; + dSP; dTARGET; PUSHi(0); PUTBACK; @@ -1747,7 +1769,7 @@ restart: int PerlProcFork(struct IPerlProc* piPerl) { - dTHXo; + dTHX; #ifdef USE_ITHREADS DWORD id; HANDLE handle; @@ -1758,7 +1780,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, @@ -1772,7 +1794,7 @@ PerlProcFork(struct IPerlProc* piPerl) new_perl->Isys_intern.internal_host = h; # ifdef PERL_SYNC_FORK id = win32_start_child((LPVOID)new_perl); - PERL_SET_THX(aTHXo); + PERL_SET_THX(aTHX); # else # ifdef USE_RTL_THREAD_API handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child, @@ -1781,7 +1803,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; @@ -1845,6 +1867,14 @@ PerlProcASpawn(struct IPerlProc* piPerl, void *vreally, void **vmark, void **vsp return do_aspawn(vreally, vmark, vsp); } +int +PerlProcLastHost(struct IPerlProc* piPerl) +{ + dTHX; + CPerlHost *h = (CPerlHost*)w32_internal_host; + return h->LastHost(); +} + struct IPerlProc perlProc = { PerlProcAbort, @@ -1880,6 +1910,8 @@ struct IPerlProc perlProc = PerlProcSpawn, PerlProcSpawnvp, PerlProcASpawn, + PerlProcLastHost, + PerlProcPopenList }; @@ -1889,6 +1921,8 @@ struct IPerlProc perlProc = CPerlHost::CPerlHost(void) { + /* Construct a host from scratch */ + InterlockedIncrement(&num_hosts); m_pvDir = new VDir(); m_pVMem = new VMem(); m_pVMemShared = new VMem(); @@ -1937,6 +1971,7 @@ CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared, struct IPerlDir** ppDir, struct IPerlSock** ppSock, struct IPerlProc** ppProc) { + InterlockedIncrement(&num_hosts); m_pvDir = new VDir(0); m_pVMem = new VMem(); m_pVMemShared = new VMem(); @@ -1971,6 +2006,8 @@ CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared, CPerlHost::CPerlHost(CPerlHost& host) { + /* Construct a host from another host */ + InterlockedIncrement(&num_hosts); m_pVMem = new VMem(); m_pVMemShared = host.GetMemShared(); m_pVMemParse = host.GetMemParse(); @@ -2011,6 +2048,7 @@ CPerlHost::CPerlHost(CPerlHost& host) CPerlHost::~CPerlHost(void) { // Reset(); + InterlockedDecrement(&num_hosts); delete m_pvDir; m_pVMemParse->Release(); m_pVMemShared->Release(); @@ -2098,7 +2136,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 } } @@ -2109,7 +2147,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; @@ -2152,23 +2190,23 @@ 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); if(ptr) { m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr); - length = strlen(ptr)-1; - if(length > 0) { - if((ptr[length] == '\\') || (ptr[length] == '/')) - ptr[length] = 0; + length = strlen(ptr); + if (length > 3) { + if ((ptr[length-1] == '\\') || (ptr[length-1] == '/')) + ptr[length-1] = 0; } } return ptr; @@ -2177,14 +2215,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; @@ -2252,11 +2290,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); } @@ -2273,7 +2312,7 @@ 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]); @@ -2286,9 +2325,10 @@ CPerlHost::Reset(void) 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], '='); @@ -2311,6 +2351,8 @@ CPerlHost::Clearenv(void) ch = *++lpPtr; *lpPtr = 0; Add(lpStr); + if (!w32_pseudo_id) + (void)win32_putenv(lpStr); *lpPtr = ch; } lpStr += strlen(lpStr) + 1; @@ -2323,30 +2365,35 @@ CPerlHost::Clearenv(void) char* CPerlHost::Getenv(const char *varname) { - char* pEnv = Find(varname); - if(pEnv == NULL) { - pEnv = win32_getenv(varname); + dTHX; + if (w32_pseudo_id) { + char *pEnv = Find(varname); + if (pEnv && *pEnv) + return pEnv; } - else { - if(!*pEnv) - pEnv = 0; - } - - return pEnv; + return win32_getenv(varname); } int CPerlHost::Putenv(const char *envstring) { + dTHX; Add(envstring); + if (!w32_pseudo_id) + return win32_putenv(envstring); + return 0; } int CPerlHost::Chdir(const char *dirname) { - dTHXo; + dTHX; int ret; + if (!dirname) { + errno = ENOENT; + return -1; + } if (USING_WIDE()) { WCHAR wBuffer[MAX_PATH]; A2WHELPER(dirname, wBuffer, sizeof(wBuffer));