X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=win32%2Fperlhost.h;h=7926142954b112fe3e68b7e7993b136ac82a1443;hb=cb1ce60838923277ddef8cb8d26370507470dbd7;hp=3be76ed817e990e65d0765a336ffc422870d576d;hpb=d2ee51b61413d0946f6558ae280350393bbe9b35;p=p5sagit%2Fp5-mst-13.2.git diff --git a/win32/perlhost.h b/win32/perlhost.h index 3be76ed..7926142 100644 --- 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___ @@ -20,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 @@ -214,26 +215,38 @@ protected: 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) @@ -749,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); } @@ -796,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); @@ -956,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); } @@ -979,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); } @@ -1028,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); } @@ -1664,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 @@ -1681,6 +1700,7 @@ win32_start_child(LPVOID arg) PERL_SET_THX(my_perl); + win32_checkTLS(my_perl); /* set $$ to pseudo id */ #ifdef PERL_SYNC_FORK @@ -1747,9 +1767,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); @@ -1758,7 +1780,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 @@ -1795,6 +1819,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); @@ -1845,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) { @@ -1865,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; @@ -1909,12 +1915,10 @@ struct IPerlProc perlProc = PerlProcGetpid, PerlProcDynaLoader, PerlProcGetOSError, - PerlProcDoCmd, - PerlProcSpawn, PerlProcSpawnvp, - PerlProcASpawn, PerlProcLastHost, - PerlProcPopenList + PerlProcPopenList, + PerlProcGetTimeOfDay }; @@ -2142,7 +2146,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 } } @@ -2270,7 +2274,7 @@ CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir) lpStr += nLength; lpEnvPtr += nLength; } - else { + else { // determine which string to copy next compVal = compare(&lpEnvPtr, &lpLocalEnv); if(compVal < 0) {