return win32_uname(name);
}
+void
+PerlEnvClearenv(struct IPerlEnv*)
+{
+ dTHXo;
+ char *envv = GetEnvironmentStrings();
+ char *cur = envv;
+ STRLEN len;
+ while (*cur) {
+ char *end = strchr(cur,'=');
+ if (end && end != cur) {
+ *end = '\0';
+ my_setenv(cur,Nullch);
+ *end = '=';
+ cur = end + strlen(end+1)+2;
+ }
+ else if ((len = strlen(cur)))
+ cur += len+1;
+ }
+ FreeEnvironmentStrings(envv);
+}
+
+void*
+PerlEnvGetChildEnv(struct IPerlEnv*)
+{
+ return NULL;
+}
+
+void
+PerlEnvFreeChildEnv(struct IPerlEnv*, void* env)
+{
+}
+
+char*
+PerlEnvGetChildDir(struct IPerlEnv*)
+{
+ return NULL;
+}
+
+void
+PerlEnvFreeChildDir(struct IPerlEnv*, char* dir)
+{
+}
+
unsigned long
PerlEnvOsId(struct IPerlEnv*)
{
PerlEnvPutenv,
PerlEnvGetenv_len,
PerlEnvUname,
- NULL,
+ PerlEnvClearenv,
+ PerlEnvGetChildEnv,
+ PerlEnvFreeChildEnv,
+ PerlEnvGetChildDir,
+ PerlEnvFreeChildDir,
PerlEnvOsId,
PerlEnvLibPath,
PerlEnvSiteLibPath,
void
PerlStdIOInitOSExtras(struct IPerlStdIO*)
{
+ dTHXo;
+ xs_init(pPerl);
Perl_init_os_extras();
}
struct hostent*
PerlSockGethostent(struct IPerlSock*)
{
- dPERLOBJ;
+ dTHXo;
croak("gethostent not implemented!\n");
return NULL;
}
int
PerlSockSocketpair(struct IPerlSock*, int domain, int type, int protocol, int* fds)
{
- dPERLOBJ;
+ dTHXo;
croak("socketpair not implemented!\n");
return 0;
}
int
PerlProcKillpg(struct IPerlProc*, int pid, int sig)
{
- dPERLOBJ;
+ dTHXo;
croak("killpg not implemented!\n");
return 0;
}
//#include "perlhost.h"
-static DWORD g_TlsAllocIndex;
-BOOL SetPerlInterpreter(CPerlObj* pPerl)
-{
- return TlsSetValue(g_TlsAllocIndex, pPerl);
-}
-
-EXTERN_C CPerlObj* GetPerlInterpreter(PerlInterpreter* sv_interp)
-{
- if(GetCurrentThreadId() == (DWORD)sv_interp)
- return (CPerlObj*)TlsGetValue(g_TlsAllocIndex);
- return NULL;
-}
-
-CPerlObj* GetPerlInter(void)
-{
- return (CPerlObj*)TlsGetValue(g_TlsAllocIndex);
-}
-
EXTERN_C void perl_get_host_info(IPerlMemInfo* perlMemInfo,
IPerlEnvInfo* perlEnvInfo, IPerlStdIOInfo* perlStdIOInfo,
if(pPerl)
{
SetPerlInterpreter(pPerl);
- return (PerlInterpreter*)GetCurrentThreadId();
+ return (PerlInterpreter*)pPerl;
}
SetPerlInterpreter(NULL);
return NULL;
if(pPerl)
{
SetPerlInterpreter(pPerl);
- return (PerlInterpreter*)GetCurrentThreadId();
+ return (PerlInterpreter*)pPerl;
}
SetPerlInterpreter(NULL);
return NULL;
EXTERN_C void perl_construct(PerlInterpreter* sv_interp)
{
- CPerlObj* pPerl = GetPerlInterpreter(sv_interp);
+ CPerlObj* pPerl = (CPerlObj*)sv_interp;
try
{
pPerl->perl_construct();
EXTERN_C void perl_destruct(PerlInterpreter* sv_interp)
{
- CPerlObj* pPerl = GetPerlInterpreter(sv_interp);
+ CPerlObj* pPerl = (CPerlObj*)sv_interp;
try
{
pPerl->perl_destruct();
EXTERN_C void perl_free(PerlInterpreter* sv_interp)
{
- CPerlObj* pPerl = GetPerlInterpreter(sv_interp);
+ CPerlObj* pPerl = (CPerlObj*)sv_interp;
try
{
pPerl->perl_free();
EXTERN_C int perl_run(PerlInterpreter* sv_interp)
{
- CPerlObj* pPerl = GetPerlInterpreter(sv_interp);
+ CPerlObj* pPerl = (CPerlObj*)sv_interp;
int retVal;
try
{
EXTERN_C int perl_parse(PerlInterpreter* sv_interp, void (*xsinit)(CPerlObj*), int argc, char** argv, char** env)
{
int retVal;
- CPerlObj* pPerl = GetPerlInterpreter(sv_interp);
+ CPerlObj* pPerl = (CPerlObj*)sv_interp;
try
{
- retVal = pPerl->perl_parse(xs_init, argc, argv, env);
+ retVal = pPerl->perl_parse(xsinit, argc, argv, env);
}
/*
catch(int x)
#undef PL_perl_destruct_level
#define PL_perl_destruct_level int dummy
-#undef w32_perldll_handle
-#define w32_perldll_handle g_w32_perldll_handle
-HANDLE g_w32_perldll_handle;
-#else
-extern HANDLE w32_perldll_handle;
#endif /* PERL_OBJECT */
-DllExport int
+extern HANDLE w32_perldll_handle;
+static DWORD g_TlsAllocIndex;
+
+EXTERN_C DllExport bool
+SetPerlInterpreter(void *interp)
+{
+ return TlsSetValue(g_TlsAllocIndex, interp);
+}
+
+EXTERN_C DllExport void*
+GetPerlInterpreter(void)
+{
+ return TlsGetValue(g_TlsAllocIndex);
+}
+
+EXTERN_C DllExport int
RunPerl(int argc, char **argv, char **env)
{
int exitstatus;
#ifdef PERL_GLOBAL_STRUCT
#define PERLVAR(var,type) /**/
+#define PERLVARA(var,type) /**/
#define PERLVARI(var,type,init) PL_Vars.var = init;
#define PERLVARIC(var,type,init) PL_Vars.var = init;
#include "perlvars.h"
#undef PERLVAR
+#undef PERLVARA
#undef PERLVARI
#undef PERLVARIC
#endif
perl_construct( my_perl );
PL_perl_destruct_level = 0;
+#ifdef PERL_OBJECT
+ /* PERL_OBJECT build sets Dynaloader in PerlStdIOInitOSExtras */
+ exitstatus = perl_parse(my_perl, NULL, argc, argv, env);
+#else
exitstatus = perl_parse(my_perl, xs_init, argc, argv, env);
+#endif
if (!exitstatus) {
exitstatus = perl_run( my_perl );
}
setmode( fileno( stderr ), O_BINARY );
_fmode = O_BINARY;
#endif
-#ifdef PERL_OBJECT
g_TlsAllocIndex = TlsAlloc();
DisableThreadLibraryCalls(hModule);
-#else
w32_perldll_handle = hModule;
-#endif
break;
/* The DLL is detaching from a process due to
* process termination or call to FreeLibrary.
*/
case DLL_PROCESS_DETACH:
-#ifdef PERL_OBJECT
TlsFree(g_TlsAllocIndex);
-#endif
break;
/* The attached process creates a new thread. */