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

p4raw-id: //depot/perl@3819

diff --git a/README.win32 b/README.win32
index 5ed7a79..6f7af54 100644 (file)
--- 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 fc88f31..9777273 100644 (file)
--- 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 39dafa8..faf1c70 100755 (executable)
--- 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 00bcf97..f6e19ac 100644 (file)
--- 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 676d229..8a79bae 100644 (file)
--- 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 38ae6a7..9af2e0d 100644 (file)
--- 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 2da82c2..8750f05 100644 (file)
--- 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 738f1f5..f2460a8 100644 (file)
--- 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 cba7e41..10b252a 100644 (file)
--- 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 b28b042..e705e4d 100644 (file)
--- 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;