From: Gurusamy Sarathy Date: Mon, 31 May 1999 17:18:23 +0000 (+0000) Subject: fix memory leak in C X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=067f92a0e46641b4b3e89afcde43bf134105f7b7;p=p5sagit%2Fp5-mst-13.2.git fix memory leak in C p4raw-id: //depot/perl@3511 --- diff --git a/embed.h b/embed.h index e413efc..aa9db44 100644 --- a/embed.h +++ b/embed.h @@ -1179,6 +1179,7 @@ #define force_word CPerlObj::Perl_force_word #define form CPerlObj::Perl_form #define fprintf CPerlObj::Perl_fprintf +#define free_closures CPerlObj::Perl_free_closures #define free_tmps CPerlObj::Perl_free_tmps #define gen_constant_list CPerlObj::Perl_gen_constant_list #define get_db_sub CPerlObj::Perl_get_db_sub diff --git a/embed.pl b/embed.pl index 028e217..381c040 100755 --- a/embed.pl +++ b/embed.pl @@ -258,6 +258,7 @@ my @staticfuncs = qw( dopoptoloop dopoptosub dopoptosub_at + free_closures save_lines doeval doopen_pmc diff --git a/objXSUB.h b/objXSUB.h index 658e5ce..d37a925 100644 --- a/objXSUB.h +++ b/objXSUB.h @@ -1221,6 +1221,8 @@ #define form pPerl->Perl_form #undef fprintf #define fprintf pPerl->Perl_fprintf +#undef free_closures +#define free_closures pPerl->Perl_free_closures #undef free_tmps #define free_tmps pPerl->Perl_free_tmps #undef gen_constant_list diff --git a/pp_ctl.c b/pp_ctl.c index a4c0247..9e78a31 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -49,6 +49,7 @@ static I32 amagic_ncmp _((SV *a, SV *b)); static I32 amagic_i_ncmp _((SV *a, SV *b)); static I32 amagic_cmp _((SV *str1, SV *str2)); static I32 amagic_cmp_locale _((SV *str1, SV *str2)); +static void free_closures _((void)); #endif PP(pp_wantarray) @@ -1324,6 +1325,42 @@ dounwind(I32 cxix) } } +/* + * Closures mentioned at top level of eval cannot be referenced + * again, and their presence indirectly causes a memory leak. + * (Note that the fact that compcv and friends are still set here + * is, AFAIK, an accident.) --Chip + * + * XXX need to get comppad et al from eval's cv rather than + * relying on the incidental global values. + */ +STATIC void +free_closures(void) +{ + dTHR; + SV **svp = AvARRAY(PL_comppad_name); + I32 ix; + for (ix = AvFILLp(PL_comppad_name); ix >= 0; ix--) { + SV *sv = svp[ix]; + if (sv && sv != &PL_sv_undef && *SvPVX(sv) == '&') { + SvREFCNT_dec(sv); + svp[ix] = &PL_sv_undef; + + sv = PL_curpad[ix]; + if (CvCLONE(sv)) { + SvREFCNT_dec(CvOUTSIDE(sv)); + CvOUTSIDE(sv) = Nullcv; + } + else { + SvREFCNT_dec(sv); + sv = NEWSV(0,0); + SvPADTMP_on(sv); + PL_curpad[ix] = sv; + } + } + } +} + OP * die_where(char *message, STRLEN msglen) { @@ -1804,6 +1841,9 @@ PP(pp_return) break; case CXt_EVAL: POPEVAL(cx); + if (AvFILLp(PL_comppad_name) >= 0) + free_closures(); + lex_end(); if (optype == OP_REQUIRE && (MARK == SP || (gimme == G_SCALAR && !SvTRUE(*SP))) ) { @@ -3083,35 +3123,8 @@ PP(pp_leaveeval) } PL_curpm = newpm; /* Don't pop $1 et al till now */ - /* - * Closures mentioned at top level of eval cannot be referenced - * again, and their presence indirectly causes a memory leak. - * (Note that the fact that compcv and friends are still set here - * is, AFAIK, an accident.) --Chip - */ - if (AvFILLp(PL_comppad_name) >= 0) { - SV **svp = AvARRAY(PL_comppad_name); - I32 ix; - for (ix = AvFILLp(PL_comppad_name); ix >= 0; ix--) { - SV *sv = svp[ix]; - if (sv && sv != &PL_sv_undef && *SvPVX(sv) == '&') { - SvREFCNT_dec(sv); - svp[ix] = &PL_sv_undef; - - sv = PL_curpad[ix]; - if (CvCLONE(sv)) { - SvREFCNT_dec(CvOUTSIDE(sv)); - CvOUTSIDE(sv) = Nullcv; - } - else { - SvREFCNT_dec(sv); - sv = NEWSV(0,0); - SvPADTMP_on(sv); - PL_curpad[ix] = sv; - } - } - } - } + if (AvFILLp(PL_comppad_name) >= 0) + free_closures(); #ifdef DEBUGGING assert(CvDEPTH(PL_compcv) == 1); diff --git a/proto.h b/proto.h index 6ec5b37..89c70fc 100644 --- a/proto.h +++ b/proto.h @@ -760,6 +760,7 @@ I32 dopoptolabel _((char *label)); I32 dopoptoloop _((I32 startingblock)); I32 dopoptosub _((I32 startingblock)); I32 dopoptosub_at _((PERL_CONTEXT* cxstk, I32 startingblock)); +void free_closures _((void)); void save_lines _((AV *array, SV *sv)); OP *doeval _((int gimme, OP** startop)); PerlIO *doopen_pmc _((const char *name, const char *mode));