diff options
| -rw-r--r-- | embed.h | 18 | ||||
| -rwxr-xr-x | embed.pl | 5 | ||||
| -rw-r--r-- | global.sym | 3 | ||||
| -rw-r--r-- | makedef.pl | 1 | ||||
| -rw-r--r-- | objXSUB.h | 14 | ||||
| -rw-r--r-- | perl.c | 4 | ||||
| -rw-r--r-- | perlapi.c | 23 | ||||
| -rw-r--r-- | proto.h | 5 | ||||
| -rw-r--r-- | win32/win32.c | 14 |
9 files changed, 55 insertions, 32 deletions
@@ -825,16 +825,15 @@ #define mg_dup Perl_mg_dup #define sv_dup Perl_sv_dup #if defined(HAVE_INTERP_INTERN) +#define sys_intern_clear Perl_sys_intern_clear #define sys_intern_dup Perl_sys_intern_dup +#define sys_intern_init Perl_sys_intern_init #endif #define ptr_table_new Perl_ptr_table_new #define ptr_table_fetch Perl_ptr_table_fetch #define ptr_table_store Perl_ptr_table_store #define ptr_table_split Perl_ptr_table_split #endif -#if defined(HAVE_INTERP_INTERN) -#define sys_intern_init Perl_sys_intern_init -#endif #if defined(PERL_OBJECT) #else #endif @@ -2266,16 +2265,15 @@ #define mg_dup(a) Perl_mg_dup(aTHX_ a) #define sv_dup(a) Perl_sv_dup(aTHX_ a) #if defined(HAVE_INTERP_INTERN) +#define sys_intern_clear() Perl_sys_intern_clear(aTHX) #define sys_intern_dup(a,b) Perl_sys_intern_dup(aTHX_ a,b) +#define sys_intern_init() Perl_sys_intern_init(aTHX) #endif #define ptr_table_new() Perl_ptr_table_new(aTHX) #define ptr_table_fetch(a,b) Perl_ptr_table_fetch(aTHX_ a,b) #define ptr_table_store(a,b,c) Perl_ptr_table_store(aTHX_ a,b,c) #define ptr_table_split(a) Perl_ptr_table_split(aTHX_ a) #endif -#if defined(HAVE_INTERP_INTERN) -#define sys_intern_init() Perl_sys_intern_init(aTHX) -#endif #if defined(PERL_OBJECT) #else #endif @@ -4443,8 +4441,12 @@ #define Perl_sv_dup CPerlObj::Perl_sv_dup #define sv_dup Perl_sv_dup #if defined(HAVE_INTERP_INTERN) +#define Perl_sys_intern_clear CPerlObj::Perl_sys_intern_clear +#define sys_intern_clear Perl_sys_intern_clear #define Perl_sys_intern_dup CPerlObj::Perl_sys_intern_dup #define sys_intern_dup Perl_sys_intern_dup +#define Perl_sys_intern_init CPerlObj::Perl_sys_intern_init +#define sys_intern_init Perl_sys_intern_init #endif #define Perl_ptr_table_new CPerlObj::Perl_ptr_table_new #define ptr_table_new Perl_ptr_table_new @@ -4455,10 +4457,6 @@ #define Perl_ptr_table_split CPerlObj::Perl_ptr_table_split #define ptr_table_split Perl_ptr_table_split #endif -#if defined(HAVE_INTERP_INTERN) -#define Perl_sys_intern_init CPerlObj::Perl_sys_intern_init -#define sys_intern_init Perl_sys_intern_init -#endif #if defined(PERL_OBJECT) #else #endif @@ -2155,17 +2155,16 @@ Ap |GP* |gp_dup |GP* gp Ap |MAGIC* |mg_dup |MAGIC* mg Ap |SV* |sv_dup |SV* sstr #if defined(HAVE_INTERP_INTERN) +Ap |void |sys_intern_clear Ap |void |sys_intern_dup |struct interp_intern* src \ |struct interp_intern* dst +Ap |void |sys_intern_init #endif Ap |PTR_TBL_t*|ptr_table_new Ap |void* |ptr_table_fetch|PTR_TBL_t *tbl|void *sv Ap |void |ptr_table_store|PTR_TBL_t *tbl|void *oldsv|void *newsv Ap |void |ptr_table_split|PTR_TBL_t *tbl #endif -#if defined(HAVE_INTERP_INTERN) -Ap |void |sys_intern_init -#endif #if defined(PERL_OBJECT) protected: diff --git a/global.sym b/global.sym index ec6180b2f1..15afc0c2b6 100644 --- a/global.sym +++ b/global.sym @@ -536,9 +536,10 @@ Perl_dirp_dup Perl_gp_dup Perl_mg_dup Perl_sv_dup +Perl_sys_intern_clear Perl_sys_intern_dup +Perl_sys_intern_init Perl_ptr_table_new Perl_ptr_table_fetch Perl_ptr_table_store Perl_ptr_table_split -Perl_sys_intern_init diff --git a/makedef.pl b/makedef.pl index ae68674aa7..b47237ce82 100644 --- a/makedef.pl +++ b/makedef.pl @@ -259,6 +259,7 @@ elsif ($PLATFORM eq 'aix') { Perl_safexrealloc Perl_same_dirent Perl_unlnk + Perl_sys_intern_clear Perl_sys_intern_dup Perl_sys_intern_init PL_cryptseen @@ -2166,10 +2166,18 @@ #undef sv_dup #define sv_dup Perl_sv_dup #if defined(HAVE_INTERP_INTERN) +#undef Perl_sys_intern_clear +#define Perl_sys_intern_clear pPerl->Perl_sys_intern_clear +#undef sys_intern_clear +#define sys_intern_clear Perl_sys_intern_clear #undef Perl_sys_intern_dup #define Perl_sys_intern_dup pPerl->Perl_sys_intern_dup #undef sys_intern_dup #define sys_intern_dup Perl_sys_intern_dup +#undef Perl_sys_intern_init +#define Perl_sys_intern_init pPerl->Perl_sys_intern_init +#undef sys_intern_init +#define sys_intern_init Perl_sys_intern_init #endif #undef Perl_ptr_table_new #define Perl_ptr_table_new pPerl->Perl_ptr_table_new @@ -2188,12 +2196,6 @@ #undef ptr_table_split #define ptr_table_split Perl_ptr_table_split #endif -#if defined(HAVE_INTERP_INTERN) -#undef Perl_sys_intern_init -#define Perl_sys_intern_init pPerl->Perl_sys_intern_init -#undef sys_intern_init -#define sys_intern_init Perl_sys_intern_init -#endif #if defined(PERL_OBJECT) #else #endif @@ -657,6 +657,10 @@ perl_destruct(pTHXx) SvREFCNT_dec(PL_fdpid); /* needed in io_close() */ PL_fdpid = Nullav; +#ifdef HAVE_INTERP_INTERN + sys_intern_clear(); +#endif + /* Destruct the global string table. */ { /* Yell and reset the HeVAL() slots that are still holding refcounts, @@ -3914,12 +3914,26 @@ Perl_sv_dup(pTHXo_ SV* sstr) } #if defined(HAVE_INTERP_INTERN) +#undef Perl_sys_intern_clear +void +Perl_sys_intern_clear(pTHXo) +{ + ((CPerlObj*)pPerl)->Perl_sys_intern_clear(); +} + #undef Perl_sys_intern_dup void Perl_sys_intern_dup(pTHXo_ struct interp_intern* src, struct interp_intern* dst) { ((CPerlObj*)pPerl)->Perl_sys_intern_dup(src, dst); } + +#undef Perl_sys_intern_init +void +Perl_sys_intern_init(pTHXo) +{ + ((CPerlObj*)pPerl)->Perl_sys_intern_init(); +} #endif #undef Perl_ptr_table_new @@ -3950,15 +3964,6 @@ Perl_ptr_table_split(pTHXo_ PTR_TBL_t *tbl) ((CPerlObj*)pPerl)->Perl_ptr_table_split(tbl); } #endif -#if defined(HAVE_INTERP_INTERN) - -#undef Perl_sys_intern_init -void -Perl_sys_intern_init(pTHXo) -{ - ((CPerlObj*)pPerl)->Perl_sys_intern_init(); -} -#endif #if defined(PERL_OBJECT) #else #endif @@ -933,16 +933,15 @@ PERL_CALLCONV GP* Perl_gp_dup(pTHX_ GP* gp); PERL_CALLCONV MAGIC* Perl_mg_dup(pTHX_ MAGIC* mg); PERL_CALLCONV SV* Perl_sv_dup(pTHX_ SV* sstr); #if defined(HAVE_INTERP_INTERN) +PERL_CALLCONV void Perl_sys_intern_clear(pTHX); PERL_CALLCONV void Perl_sys_intern_dup(pTHX_ struct interp_intern* src, struct interp_intern* dst); +PERL_CALLCONV void Perl_sys_intern_init(pTHX); #endif PERL_CALLCONV PTR_TBL_t* Perl_ptr_table_new(pTHX); PERL_CALLCONV void* Perl_ptr_table_fetch(pTHX_ PTR_TBL_t *tbl, void *sv); PERL_CALLCONV void Perl_ptr_table_store(pTHX_ PTR_TBL_t *tbl, void *oldsv, void *newsv); PERL_CALLCONV void Perl_ptr_table_split(pTHX_ PTR_TBL_t *tbl); #endif -#if defined(HAVE_INTERP_INTERN) -PERL_CALLCONV void Perl_sys_intern_init(pTHX); -#endif #if defined(PERL_OBJECT) protected: diff --git a/win32/win32.c b/win32/win32.c index c589ff5e88..750f6fb9c6 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -4032,6 +4032,8 @@ win32_get_child_IO(child_IO_table* ptbl) # define Perl_sys_intern_init CPerlObj::Perl_sys_intern_init # undef Perl_sys_intern_dup # define Perl_sys_intern_dup CPerlObj::Perl_sys_intern_dup +# undef Perl_sys_intern_clear +# define Perl_sys_intern_clear CPerlObj::Perl_sys_intern_clear # define pPerl this # endif @@ -4066,6 +4068,18 @@ Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst) Newz(1313, dst->pseudo_children, 1, child_tab); dst->thr_intern.Winit_socktype = src->thr_intern.Winit_socktype; } + +void +Perl_sys_intern_clear(pTHX) +{ + Safefree(w32_perlshell_tokens); + Safefree(w32_perlshell_vec); + /* NOTE: w32_fdpid is freed by sv_clean_all() */ + Safefree(w32_children); +# ifdef USE_ITHREADS + Safefree(w32_pseudo_children); +# endif +} # endif /* USE_ITHREADS */ #endif /* HAVE_INTERP_INTERN */ |