summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGurusamy Sarathy <gsar@cpan.org>1999-07-28 18:08:06 +0000
committerGurusamy Sarathy <gsar@cpan.org>1999-07-28 18:08:06 +0000
commit3075ddba723b9b3d732695035818e7b3e7287e85 (patch)
tree4cb160adc07d92b9a6d9068d4f07693f221e2e72
parent71ad7795db6b8d545a629fdaf0efbb677f2f2921 (diff)
downloadperl-3075ddba723b9b3d732695035818e7b3e7287e85.tar.gz
misc PERL_OBJECT tweaks; perlcore.dll is now perl56.dll
p4raw-id: //depot/perl@3819
-rw-r--r--README.win322
-rw-r--r--globals.c9
-rwxr-xr-xinstallperl2
-rw-r--r--iperlsys.h33
-rw-r--r--makedef.pl2
-rw-r--r--perl.h1
-rw-r--r--win32/Makefile4
-rw-r--r--win32/makefile.mk4
-rw-r--r--win32/perllib.c66
-rw-r--r--win32/win32.c41
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;