From: Gurusamy Sarathy Date: Tue, 4 Jul 2000 04:37:00 +0000 (+0000) Subject: fix memory leak on Windows (PL_sys_intern contents were never X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6c644e7885bc20d759d8cbcb4abaa8f14113c03b;p=p5sagit%2Fp5-mst-13.2.git fix memory leak on Windows (PL_sys_intern contents were never freed) p4raw-id: //depot/perl@6299 --- diff --git a/embed.h b/embed.h index 33ef720..301619e 100644 --- a/embed.h +++ b/embed.h @@ -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 diff --git a/embed.pl b/embed.pl index 8a89103..d760576 100755 --- a/embed.pl +++ b/embed.pl @@ -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 ec6180b..15afc0c 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 ae68674..b47237c 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 diff --git a/objXSUB.h b/objXSUB.h index 25536e9..7f14e2f 100644 --- a/objXSUB.h +++ b/objXSUB.h @@ -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 diff --git a/perl.c b/perl.c index 33ca540..9736d3b 100644 --- a/perl.c +++ b/perl.c @@ -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, diff --git a/perlapi.c b/perlapi.c index 10a7a37..6a2b5b0 100644 --- a/perlapi.c +++ b/perlapi.c @@ -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 diff --git a/proto.h b/proto.h index 28c9581..da7d9bc 100644 --- a/proto.h +++ b/proto.h @@ -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 c589ff5..750f6fb 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 */