/* 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.
*/
+#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
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); };
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;
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); };
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);
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)
win32_get_child_IO(ptr);
}
-struct IPerlEnv perlEnv =
+struct IPerlEnv perlEnv =
{
PerlEnvGetenv,
PerlEnvPutenv,
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);
}
#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
*/
return pfdup;
}
-struct IPerlStdIO perlStdIO =
+struct IPerlStdIO perlStdIO =
{
PerlStdIOStdin,
PerlStdIOStdout,
}
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
};
m_dwEnvCount = 0;
m_lppEnvList = NULL;
+ m_bTopLevel = TRUE;
CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
m_dwEnvCount = 0;
m_lppEnvList = NULL;
+ m_bTopLevel = FALSE;
CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem));
CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared));
m_dwEnvCount = 0;
m_lppEnvList = NULL;
+ m_bTopLevel = FALSE;
/* duplicate environment info */
LPSTR lpPtr;
if(c1 != c2) {
if(c1 < c2)
return -1; // string 1 < string 2
-
+
return 1; // string 1 > string 2
}
}
lpStr += nLength;
lpEnvPtr += nLength;
}
- else {
+ else {
// determine which string to copy next
compVal = compare(&lpEnvPtr, &lpLocalEnv);
if(compVal < 0) {
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);
}
ch = *++lpPtr;
*lpPtr = 0;
Add(lpStr);
- if (!w32_pseudo_id)
+ if (m_bTopLevel)
(void)win32_putenv(lpStr);
*lpPtr = ch;
}
CPerlHost::Getenv(const char *varname)
{
dTHX;
- if (w32_pseudo_id) {
+ if (!m_bTopLevel) {
char *pEnv = Find(varname);
if (pEnv && *pEnv)
return pEnv;
{
dTHX;
Add(envstring);
- if (!w32_pseudo_id)
+ if (m_bTopLevel)
return win32_putenv(envstring);
return 0;