misc PERL_OBJECT tweaks; perlcore.dll is now perl56.dll

p4raw-id: //depot/perl@3819

4 files changed, 100 insertions, 15 deletions

diff --git a/win32/Makefile b/win32/Makefile
index 2da82c2ffa..8750f0587c 100644
--- a/win32/Makefile
+++ b/win32/Makefile
@@ -341,8 +341,8 @@ EXTUTILSDIR	= $(LIBDIR)\extutils
 #
 # various targets
 !IF "$(USE_OBJECT)" == "define"
-PERLIMPLIB	= ..\perlcore.lib
-PERLDLL		= ..\perlcore.dll
+PERLIMPLIB	= ..\perl56.lib
+PERLDLL		= ..\perl56.dll
 !ELSE
 PERLIMPLIB	= ..\perl.lib
 PERLDLL		= ..\perl.dll
diff --git a/win32/makefile.mk b/win32/makefile.mk
index 738f1f5ef3..f2460a835b 100644
--- a/win32/makefile.mk
+++ b/win32/makefile.mk
@@ -502,8 +502,8 @@ PERL95EXE	= ..\perl95.exe
 .ENDIF
 
 .IF "$(USE_OBJECT)" == "define"
-PERLIMPLIB	*= ..\perlcore$(a)
-PERLDLL		= ..\perlcore.dll
+PERLIMPLIB	*= ..\perl56$(a)
+PERLDLL		= ..\perl56.dll
 .ELSE
 PERLIMPLIB	*= ..\perl$(a)
 PERLDLL		= ..\perl.dll
diff --git a/win32/perllib.c b/win32/perllib.c
index cba7e41881..10b252a8db 100644
--- a/win32/perllib.c
+++ b/win32/perllib.c
@@ -91,6 +91,49 @@ PerlEnvUname(struct IPerlEnv*, struct utsname *name)
     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*)
 {
@@ -115,7 +158,11 @@ struct IPerlEnv perlEnv =
     PerlEnvPutenv,
     PerlEnvGetenv_len,
     PerlEnvUname,
-    NULL,
+    PerlEnvClearenv,
+    PerlEnvGetChildEnv,
+    PerlEnvFreeChildEnv,
+    PerlEnvGetChildDir,
+    PerlEnvFreeChildDir,
     PerlEnvOsId,
     PerlEnvLibPath,
     PerlEnvSiteLibPath,
@@ -375,6 +422,8 @@ PerlStdIOInit(struct IPerlStdIO*)
 void
 PerlStdIOInitOSExtras(struct IPerlStdIO*)
 {
+    dTHXo;
+    xs_init(pPerl);
     Perl_init_os_extras();
 }
 
@@ -1407,7 +1456,7 @@ EXTERN_C int perl_parse(PerlInterpreter* sv_interp, void (*xsinit)(CPerlObj*), i
     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)
@@ -1427,13 +1476,9 @@ EXTERN_C int perl_parse(PerlInterpreter* sv_interp, void (*xsinit)(CPerlObj*), i
 
 #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 */
 
+extern HANDLE w32_perldll_handle;
 static DWORD g_TlsAllocIndex;
 
 EXTERN_C DllExport bool
@@ -1486,7 +1531,12 @@ RunPerl(int argc, char **argv, char **env)
     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 );
     }
@@ -1518,9 +1568,7 @@ DllMain(HANDLE hModule,		/* DLL module handle */
 #endif
 	g_TlsAllocIndex = TlsAlloc();
 	DisableThreadLibraryCalls(hModule);
-#ifndef PERL_OBJECT
 	w32_perldll_handle = hModule;
-#endif
 	break;
 
 	/* The DLL is detaching from a process due to
diff --git a/win32/win32.c b/win32/win32.c
index b28b042d66..e705e4d765 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -2475,6 +2475,35 @@ GIVE_UP:
     return Nullch;
 }
 
+/* The following are just place holders.
+ * Some hosts may provide and environment that the OS is
+ * not tracking, therefore, these host must provide that
+ * environment and the current directory to CreateProcess
+ */
+
+void*
+get_childenv(void)
+{
+    return NULL;
+}
+
+void
+free_childenv(void*)
+{
+}
+
+char*
+get_childdir(void)
+{
+    return NULL;
+}
+
+void
+free_childdir(char*)
+{
+}
+
+
 /* XXX this needs to be made more compatible with the spawnvp()
  * provided by the various RTLs.  In particular, searching for
  * *.{com,bat,cmd} files (as done by the RTLs) is unimplemented.
@@ -2494,6 +2523,8 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
 #else
     dTHXo;
     DWORD ret;
+    void* env;
+    char* dir;
     STARTUPINFO StartupInfo;
     PROCESS_INFORMATION ProcessInformation;
     DWORD create = 0;
@@ -2502,6 +2533,9 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
 			     	             ? &argv[1] : argv);
     char *fullcmd = Nullch;
 
+    env = PerlEnv_get_childenv();
+    dir = PerlEnv_get_childdir();
+
     switch(mode) {
     case P_NOWAIT:	/* asynch + remember result */
 	if (w32_num_children >= MAXIMUM_WAIT_OBJECTS) {
@@ -2544,8 +2578,8 @@ RETRY:
 		       NULL,		/* thread attributes */
 		       TRUE,		/* inherit handles */
 		       create,		/* creation flags */
-		       NULL,		/* inherit environment */
-		       NULL,		/* inherit cwd */
+		       (LPVOID)env,	/* inherit environment */
+		       dir,		/* inherit cwd */
 		       &StartupInfo,
 		       &ProcessInformation))
     {
@@ -2580,7 +2614,10 @@ RETRY:
     }
 
     CloseHandle(ProcessInformation.hThread);
+
 RETVAL:
+    PerlEnv_free_childenv(env);
+    PerlEnv_free_childdir(dir);
     Safefree(cmd);
     Safefree(fullcmd);
     return (int)ret;