* License or the Artistic License, as specified in the README file.
*/
+#define CHECK_HOST_INTERP
+
#ifndef ___PerlHost_H___
#define ___PerlHost_H___
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)
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
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);
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 */
+ // 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;
}
#endif /* ___PerlHost_H___ */
+
https://perl5.git.perl.org / perl5.git / blobdiff