From: Gurusamy Sarathy Date: Wed, 28 Jul 1999 18:08:06 +0000 (+0000) Subject: misc PERL_OBJECT tweaks; perlcore.dll is now perl56.dll X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3075ddba723b9b3d732695035818e7b3e7287e85;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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;