* License or the Artistic License, as specified in the README file.
*/
+#define CHECK_HOST_INTERP
+
#ifndef ___PerlHost_H___
#define ___PerlHost_H___
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
DWORD m_dwEnvCount;
LPSTR* m_lppEnvList;
- BOOL m_bTopLevel; /* is this a toplevel host? */
+ 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)
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);
}
}
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);
}
int
-PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, struct stat *buffer)
+PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, Stat_t *buffer)
{
return win32_fstat(handle, buffer);
}
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);
}
}
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);
}
int
PerlSockSocketpair(struct IPerlSock* piPerl, int domain, int type, int protocol, int* fds)
{
- dTHX;
- Perl_croak(aTHX_ "socketpair not implemented!\n");
- return 0;
+ return Perl_my_socketpair(domain, type, protocol, fds);
}
int
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
PERL_SET_THX(my_perl);
+ win32_checkTLS(my_perl);
/* set $$ to pseudo id */
#ifdef PERL_SYNC_FORK
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);
+ }
hv_clear(PL_pidstatus);
/* push a zero on the stack (we are the child) */
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);
}
/* 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
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);
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)
{
}
int
-PerlProcASpawn(struct IPerlProc* piPerl, void *vreally, void **vmark, void **vsp)
-{
- return do_aspawn(vreally, vmark, vsp);
-}
-
-int
PerlProcLastHost(struct IPerlProc* piPerl)
{
dTHX;
PerlProcGetpid,
PerlProcDynaLoader,
PerlProcGetOSError,
- PerlProcDoCmd,
- PerlProcSpawn,
PerlProcSpawnvp,
- PerlProcASpawn,
PerlProcLastHost,
- PerlProcPopenList
+ PerlProcPopenList,
+ PerlProcGetTimeOfDay
};
CPerlHost::~CPerlHost(void)
{
-/* Reset(); */
+// Reset();
InterlockedDecrement(&num_hosts);
delete m_pvDir;
m_pVMemParse->Release();
int
lookup(const void *arg1, const void *arg2)
-{ /* Compare strings */
+{ // Compare strings
char*ptr1, *ptr2;
char c1,c2;
if(c2 == '\0' || c2 == '=')
break;
- return -1; /* string 1 < string 2 */
+ return -1; // string 1 < string 2
}
else if(c2 == '\0' || c2 == '=')
- return 1; /* string 1 > string 2 */
+ return 1; // string 1 > string 2
else if(c1 != c2) {
c1 = toupper(c1);
c2 = toupper(c2);
if(c1 != c2) {
if(c1 < c2)
- return -1; /* string 1 < string 2 */
+ return -1; // string 1 < string 2
- return 1; /* string 1 > string 2 */
+ return 1; // string 1 > string 2
}
}
}
int
compare(const void *arg1, const void *arg2)
-{ /* Compare strings */
+{ // Compare strings
char*ptr1, *ptr2;
char c1,c2;
if(c1 == c2)
break;
- return -1; /* string 1 < string 2 */
+ return -1; // string 1 < string 2
}
else if(c2 == '\0' || c2 == '=')
- return 1; /* string 1 > string 2 */
+ return 1; // string 1 > string 2
else if(c1 != c2) {
c1 = toupper(c1);
c2 = toupper(c2);
if(c1 != c2) {
if(c1 < c2)
- return -1; /* string 1 < string 2 */
-
- return 1; /* string 1 > string 2 */
+ return -1; // string 1 < string 2
+
+ return 1; // string 1 > string 2
}
}
}
szBuffer[index] = '\0';
- /* replacing ? */
+ // replacing ?
lpPtr = Lookup(szBuffer);
if(lpPtr != NULL) {
Renew(*lpPtr, length, char);
DWORD dwSize, dwEnvIndex;
int nLength, compVal;
- /* get the process environment strings */
+ // get the process environment strings
lpAllocPtr = lpTmp = (LPSTR)GetEnvironmentStrings();
- /* step over current directory stuff */
+ // step over current directory stuff
while(*lpTmp == '=')
lpTmp += strlen(lpTmp) + 1;
- /* save the start of the environment strings */
+ // save the start of the environment strings
lpEnvPtr = lpTmp;
for(dwSize = 1; *lpTmp != '\0'; lpTmp += strlen(lpTmp) + 1) {
- /* calculate the size of the environment strings */
+ // calculate the size of the environment strings
dwSize += strlen(lpTmp) + 1;
}
- /* add the size of current directories */
+ // add the size of current directories
dwSize += vDir.CalculateEnvironmentSpace();
- /* add the additional space used by changes made to the environment */
+ // add the additional space used by changes made to the environment
dwSize += CalculateEnvironmentSpace();
New(1, lpStr, dwSize, char);
lpPtr = lpStr;
if(lpStr != NULL) {
- /* build the local environment */
+ // build the local environment
lpStr = vDir.BuildEnvironmentSpace(lpStr);
dwEnvIndex = 0;
lpLocalEnv = GetIndex(dwEnvIndex);
while(*lpEnvPtr != '\0') {
if(!lpLocalEnv) {
- /* all environment overrides have been added */
- /* so copy string into place */
+ // all environment overrides have been added
+ // so copy string into place
strcpy(lpStr, lpEnvPtr);
nLength = strlen(lpEnvPtr) + 1;
lpStr += nLength;
lpEnvPtr += nLength;
}
- else {
- /* determine which string to copy next */
+ else {
+ // determine which string to copy next
compVal = compare(&lpEnvPtr, &lpLocalEnv);
if(compVal < 0) {
strcpy(lpStr, lpEnvPtr);
}
lpLocalEnv = GetIndex(dwEnvIndex);
if(compVal == 0) {
- /* this string was replaced */
+ // this string was replaced
lpEnvPtr += strlen(lpEnvPtr) + 1;
}
}
}
while(lpLocalEnv) {
- /* still have environment overrides to add */
- /* so copy the strings into place if not an override */
+ // still have environment overrides to add
+ // so copy the strings into place if not an override
char *ptr = strchr(lpLocalEnv, '=');
if(ptr && ptr[1]) {
strcpy(lpStr, lpLocalEnv);
lpLocalEnv = GetIndex(dwEnvIndex);
}
- /* add final NULL */
+ // add final NULL
*lpStr = '\0';
}
- /* release the process environment strings */
+ // release the process environment strings
FreeEnvironmentStrings(lpAllocPtr);
return lpPtr;