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

p4raw-id: //depot/perl@3819

10 files changed, 138 insertions, 26 deletions

diff --git a/README.win32 b/README.win32
index 5ed7a79a3c..6f7af5476d 100644
--- a/README.win32
+++ b/README.win32
@@ -206,7 +206,7 @@ instructions carefully.
 Type "dmake" (or "nmake" if you are using that make).
 
 This should build everything.  Specifically, it will create perl.exe,
-perl.dll (or perlcore.dll), and perlglob.exe at the perl toplevel, and
+perl.dll (or perl56.dll), and perlglob.exe at the perl toplevel, and
 various other extension dll's under the lib\auto directory.  If the build
 fails for any reason, make sure you have done the previous steps correctly.
 
diff --git a/globals.c b/globals.c
index fc88f31b3c..9777273ee6 100644
--- a/globals.c
+++ b/globals.c
@@ -35,13 +35,20 @@ CPerlObj::CPerlObj(IPerlMem* ipM, IPerlEnv* ipE, IPerlStdIO* ipStd,
 void*
 CPerlObj::operator new(size_t nSize, IPerlMem *pvtbl)
 {
-    if(pvtbl != NULL)
+    if(pvtbl)
 	return pvtbl->pMalloc(pvtbl, nSize);
 
     return NULL;
 }
 
 void
+CPerlObj::operator delete(void *pPerl, IPerlMem *pvtbl)
+{
+    if(pvtbl)
+	pvtbl->pFree(pvtbl, pPerl);
+}
+
+void
 CPerlObj::Init(void)
 {
 }
diff --git a/installperl b/installperl
index 39dafa8ba7..faf1c70ca6 100755
--- a/installperl
+++ b/installperl
@@ -158,7 +158,7 @@ if ($Is_Cygwin) {
   };
 } else {
   $perldll = 'perl.' . $dlext;
-  $perldll = 'perlcore.' . $dlext if $Config{'ccflags'} =~ /PERL_OBJECT/i;
+  $perldll = 'perl56.' . $dlext if $Config{'ccflags'} =~ /PERL_OBJECT/i;
 }
 
 -f $perldll || die "No perl DLL built\n";
diff --git a/iperlsys.h b/iperlsys.h
index 00bcf97c4a..f6e19acb84 100644
--- a/iperlsys.h
+++ b/iperlsys.h
@@ -546,17 +546,21 @@ struct IPerlDirInfo
 struct IPerlEnv;
 typedef char*		(*LPEnvGetenv)(struct IPerlEnv*, const char*);
 typedef int		(*LPEnvPutenv)(struct IPerlEnv*, const char*);
-typedef char *		(*LPEnvGetenv_len)(struct IPerlEnv*,
+typedef char*		(*LPEnvGetenv_len)(struct IPerlEnv*,
 				    const char *varname, unsigned long *len);
 typedef int		(*LPEnvUname)(struct IPerlEnv*, struct utsname *name);
 typedef void		(*LPEnvClearenv)(struct IPerlEnv*);
-typedef unsigned long	(*LPEnvOsID)(struct IPerlEnv*);
+typedef void*		(*LPEnvGetChildenv)(struct IPerlEnv*);
+typedef void		(*LPEnvFreeChildenv)(struct IPerlEnv*, void* env);
+typedef char*		(*LPEnvGetChilddir)(struct IPerlEnv*);
+typedef void		(*LPEnvFreeChilddir)(struct IPerlEnv*, char* dir);
 #ifdef HAS_ENVGETENV
-typedef char *		(*LPENVGetenv)(struct IPerlEnv*, const char *varname);
-typedef char *		(*LPENVGetenv_len)(struct IPerlEnv*,
+typedef char*		(*LPENVGetenv)(struct IPerlEnv*, const char *varname);
+typedef char*		(*LPENVGetenv_len)(struct IPerlEnv*,
 				    const char *varname, unsigned long *len);
 #endif
 #ifdef WIN32
+typedef unsigned long	(*LPEnvOsID)(struct IPerlEnv*);
 typedef char*		(*LPEnvLibPath)(struct IPerlEnv*, char*);
 typedef char*		(*LPEnvSiteLibPath)(struct IPerlEnv*, char*);
 #endif
@@ -568,6 +572,10 @@ struct IPerlEnv
     LPEnvGetenv_len	pGetenv_len;
     LPEnvUname		pEnvUname;
     LPEnvClearenv	pClearenv;
+    LPEnvGetChildenv	pGetChildenv;
+    LPEnvFreeChildenv	pFreeChildenv;
+    LPEnvGetChilddir	pGetChilddir;
+    LPEnvFreeChilddir	pFreeChilddir;
 #ifdef HAS_ENVGETENV
     LPENVGetenv		pENVGetenv;
     LPENVGetenv_len	pENVGetenv_len;
@@ -591,10 +599,16 @@ struct IPerlEnvInfo
 	(*PL_Env->pGetenv)(PL_Env,(str))
 #define PerlEnv_getenv_len(str,l)				\
 	(*PL_Env->pGetenv_len)(PL_Env,(str), (l))
-#define PerlEnv_Clear()						\
-	(*PL_Env->pClearenv)(PL_Env)
-#define PerlEnv_Clear()						\
+#define PerlEnv_clearenv()					\
 	(*PL_Env->pClearenv)(PL_Env)
+#define PerlEnv_get_childenv()					\
+	(*PL_Env->pGetChildenv)(PL_Env)
+#define PerlEnv_free_childenv(e)				\
+	(*PL_Env->pFreeChildenv)(PL_Env, (e))
+#define PerlEnv_get_childdir()					\
+	(*PL_Env->pGetChilddir)(PL_Env)
+#define PerlEnv_free_childdir(d)				\
+	(*PL_Env->pFreeChilddir)(PL_Env, (d))
 #ifdef HAS_ENVGETENV
 #  define PerlEnv_ENVgetenv(str)				\
 	(*PL_Env->pENVGetenv)(PL_Env,(str))
@@ -622,6 +636,11 @@ struct IPerlEnvInfo
 #define PerlEnv_putenv(str)		putenv((str))
 #define PerlEnv_getenv(str)		getenv((str))
 #define PerlEnv_getenv_len(str,l)	getenv_len((str), (l))
+#define PerlEnv_clear()			clearenv()
+#define PerlEnv_get_childenv()		get_childenv()
+#define PerlEnv_free_childenv(e)	free_childenv((e))
+#define PerlEnv_get_childdir()		get_childdir()
+#define PerlEnv_free_childdir(d)	free_childdir((d))
 #ifdef HAS_ENVGETENV
 #  define PerlEnv_ENVgetenv(str)	ENVgetenv((str))
 #  define PerlEnv_ENVgetenv_len(str,l)	ENVgetenv_len((str), (l))
diff --git a/makedef.pl b/makedef.pl
index 676d229283..8a79bae431 100644
--- a/makedef.pl
+++ b/makedef.pl
@@ -68,7 +68,7 @@ close(CFG);
 if ($PLATFORM eq 'win32') {
     warn join(' ',keys %define)."\n";
     if ($define{PERL_OBJECT}) {
-	print "LIBRARY PerlCore\n";
+	print "LIBRARY Perl56\n";
 	print "DESCRIPTION 'Perl interpreter'\n";
 	print "EXPORTS\n";
 #    output_symbol("perl_alloc");
diff --git a/perl.h b/perl.h
index 38ae6a7f4b..9af2e0db44 100644
--- a/perl.h
+++ b/perl.h
@@ -2482,6 +2482,7 @@ public:
 	CPerlObj(IPerlMem*, IPerlEnv*, IPerlStdIO*, IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*);
 	void Init(void);
 	void* operator new(size_t nSize, IPerlMem *pvtbl);
+	static void operator delete(void* pPerl, IPerlMem *pvtbl);
 #endif /* PERL_OBJECT */
 
 #ifdef PERL_GLOBAL_STRUCT
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;