From: Gurusamy Sarathy Date: Fri, 2 Jun 2000 18:22:06 +0000 (+0000) Subject: fix small eval"" memory leaks under USE_ITHREADS X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f4dd75d9918abbf789a5eca453b89168cad18ff0;p=p5sagit%2Fp5-mst-13.2.git fix small eval"" memory leaks under USE_ITHREADS p4raw-id: //depot/perl@6194 --- diff --git a/cop.h b/cop.h index 3b3c3ed..d6fdd23 100644 --- a/cop.h +++ b/cop.h @@ -29,32 +29,33 @@ struct cop { # define CopFILE(c) ((c)->cop_file) # define CopFILEGV(c) (CopFILE(c) \ ? gv_fetchfile(CopFILE(c)) : Nullgv) -# define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv)) /* XXX */ +# define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv)) # define CopFILESV(c) (CopFILE(c) \ ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv) # define CopFILEAV(c) (CopFILE(c) \ ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav) # define CopSTASHPV(c) ((c)->cop_stashpv) -# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = savepv(pv)) /* XXX */ +# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = savepv(pv)) # define CopSTASH(c) (CopSTASHPV(c) \ ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv) # define CopSTASH_set(c,hv) CopSTASHPV_set(c, HvNAME(hv)) -# define CopSTASH_eq(c,hv) (hv \ +# define CopSTASH_eq(c,hv) ((hv) \ && (CopSTASHPV(c) == HvNAME(hv) \ || (CopSTASHPV(c) && HvNAME(hv) \ && strEQ(CopSTASHPV(c), HvNAME(hv))))) #else # define CopFILEGV(c) ((c)->cop_filegv) -# define CopFILEGV_set(c,gv) ((c)->cop_filegv = gv) -# define CopFILE_set(c,pv) ((c)->cop_filegv = gv_fetchfile(pv)) +# define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv)) +# define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv)) # define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv) # define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav) # define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch) # define CopSTASH(c) ((c)->cop_stash) -# define CopSTASH_set(c,hv) ((c)->cop_stash = hv) +# define CopSTASH_set(c,hv) ((c)->cop_stash = (hv)) # define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch) -# define CopSTASHPV_set(c,pv) CopSTASH_set(c, gv_stashpv(pv,GV_ADD)) -# define CopSTASH_eq(c,hv) (CopSTASH(c) == hv) + /* cop_stash is not refcounted */ +# define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD)) +# define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv)) #endif /* USE_ITHREADS */ #define CopSTASH_ne(c,hv) (!CopSTASH_eq(c,hv)) diff --git a/embed.h b/embed.h index 76ff0dc..33ef720 100644 --- a/embed.h +++ b/embed.h @@ -571,6 +571,7 @@ #define save_freeop Perl_save_freeop #define save_freepv Perl_save_freepv #define save_generic_svref Perl_save_generic_svref +#define save_generic_pvref Perl_save_generic_pvref #define save_gp Perl_save_gp #define save_hash Perl_save_hash #define save_helem Perl_save_helem @@ -2019,6 +2020,7 @@ #define save_freeop(a) Perl_save_freeop(aTHX_ a) #define save_freepv(a) Perl_save_freepv(aTHX_ a) #define save_generic_svref(a) Perl_save_generic_svref(aTHX_ a) +#define save_generic_pvref(a) Perl_save_generic_pvref(aTHX_ a) #define save_gp(a,b) Perl_save_gp(aTHX_ a,b) #define save_hash(a) Perl_save_hash(aTHX_ a) #define save_helem(a,b,c) Perl_save_helem(aTHX_ a,b,c) @@ -3954,6 +3956,8 @@ #define save_freepv Perl_save_freepv #define Perl_save_generic_svref CPerlObj::Perl_save_generic_svref #define save_generic_svref Perl_save_generic_svref +#define Perl_save_generic_pvref CPerlObj::Perl_save_generic_pvref +#define save_generic_pvref Perl_save_generic_pvref #define Perl_save_gp CPerlObj::Perl_save_gp #define save_gp Perl_save_gp #define Perl_save_hash CPerlObj::Perl_save_hash diff --git a/embed.pl b/embed.pl index 43dbde5..8a89103 100755 --- a/embed.pl +++ b/embed.pl @@ -1886,6 +1886,7 @@ Ap |void |save_freesv |SV* sv p |void |save_freeop |OP* o Ap |void |save_freepv |char* pv Ap |void |save_generic_svref|SV** sptr +Ap |void |save_generic_pvref|char** str Ap |void |save_gp |GV* gv|I32 empty Ap |HV* |save_hash |GV* gv Ap |void |save_helem |HV* hv|SV *key|SV **sptr diff --git a/objXSUB.h b/objXSUB.h index 97e9ba4..25536e9 100644 --- a/objXSUB.h +++ b/objXSUB.h @@ -1345,6 +1345,10 @@ #define Perl_save_generic_svref pPerl->Perl_save_generic_svref #undef save_generic_svref #define save_generic_svref Perl_save_generic_svref +#undef Perl_save_generic_pvref +#define Perl_save_generic_pvref pPerl->Perl_save_generic_pvref +#undef save_generic_pvref +#define save_generic_pvref Perl_save_generic_pvref #undef Perl_save_gp #define Perl_save_gp pPerl->Perl_save_gp #undef save_gp diff --git a/op.c b/op.c index 57b35ea..affb597 100644 --- a/op.c +++ b/op.c @@ -844,8 +844,8 @@ S_cop_free(pTHX_ COP* cop) { Safefree(cop->cop_label); #ifdef USE_ITHREADS - Safefree(CopFILE(cop)); /* XXXXX share in a pvtable? */ - Safefree(CopSTASHPV(cop)); /* XXXXX share in a pvtable? */ + Safefree(CopFILE(cop)); /* XXX share in a pvtable? */ + Safefree(CopSTASHPV(cop)); /* XXX share in a pvtable? */ #else /* NOTE: COP.cop_stash is not refcounted */ SvREFCNT_dec(CopFILEGV(cop)); @@ -3499,9 +3499,9 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o) PL_copline = NOLINE; } #ifdef USE_ITHREADS - CopFILE_set(cop, CopFILE(PL_curcop)); /* XXXXX share in a pvtable? */ + CopFILE_set(cop, CopFILE(PL_curcop)); /* XXX share in a pvtable? */ #else - CopFILEGV_set(cop, (GV*)SvREFCNT_inc(CopFILEGV(PL_curcop))); + CopFILEGV_set(cop, CopFILEGV(PL_curcop)); #endif CopSTASH_set(cop, PL_curstash); @@ -4709,10 +4709,11 @@ Perl_newCONSTSUB(pTHX_ HV *stash, char *name, SV *sv) dTHR; ENTER; - SAVECOPLINE(PL_curcop); - SAVEHINTS(); + SAVECOPLINE(PL_curcop); CopLINE_set(PL_curcop, PL_copline); + + SAVEHINTS(); PL_hints &= ~HINT_BLOCK_SCOPE; if (stash) { diff --git a/perl.c b/perl.c index 5df462d..801dbe1 100644 --- a/perl.c +++ b/perl.c @@ -600,9 +600,14 @@ perl_destruct(pTHXx) if (!specialWARN(PL_compiling.cop_warnings)) SvREFCNT_dec(PL_compiling.cop_warnings); PL_compiling.cop_warnings = Nullsv; -#ifndef USE_ITHREADS +#ifdef USE_ITHREADS + Safefree(CopFILE(&PL_compiling)); + CopFILE(&PL_compiling) = Nullch; + Safefree(CopSTASHPV(&PL_compiling)); +#else SvREFCNT_dec(CopFILEGV(&PL_compiling)); - CopFILEGV_set(&PL_compiling, Nullgv); + CopFILEGV(&PL_compiling) = Nullgv; + /* cop_stash is not refcounted */ #endif /* Prepare to destruct main symbol table. */ @@ -2511,6 +2516,11 @@ S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv, int *fdscript) } } +#ifdef USE_ITHREADS + Safefree(CopFILE(PL_curcop)); +#else + SvREFCNT_dec(CopFILEGV(PL_curcop)); +#endif CopFILE_set(PL_curcop, PL_origfilename); if (strEQ(PL_origfilename,"-")) scriptname = ""; diff --git a/perlapi.c b/perlapi.c index 125c6e1..10a7a37 100644 --- a/perlapi.c +++ b/perlapi.c @@ -2458,6 +2458,13 @@ Perl_save_generic_svref(pTHXo_ SV** sptr) ((CPerlObj*)pPerl)->Perl_save_generic_svref(sptr); } +#undef Perl_save_generic_pvref +void +Perl_save_generic_pvref(pTHXo_ char** str) +{ + ((CPerlObj*)pPerl)->Perl_save_generic_pvref(str); +} + #undef Perl_save_gp void Perl_save_gp(pTHXo_ GV* gv, I32 empty) diff --git a/perly.c b/perly.c index 36b51c0..d03d3de 100644 --- a/perly.c +++ b/perly.c @@ -1386,6 +1386,9 @@ yyparse() #endif struct ysv *ysave; +#ifdef USE_ITHREADS + ENTER; /* force yydestruct() before we return */ +#endif New(73, ysave, 1, struct ysv); SAVEDESTRUCTOR_X(yydestruct, ysave); ysave->oldyydebug = yydebug; @@ -2477,6 +2480,9 @@ yyoverflow: yyabort: retval = 1; yyaccept: +#ifdef USE_ITHREADS + LEAVE; /* force yydestruct() before we return */ +#endif return retval; } diff --git a/perly_c.diff b/perly_c.diff index 0b73880..0cfe10f 100644 --- a/perly_c.diff +++ b/perly_c.diff @@ -12,7 +12,7 @@ if (yys = getenv("YYDEBUG")) { yyn = *yys; ---- 1447,1473 ---- +--- 1447,1476 ---- yyparse() { register int yym, yyn, yystate; @@ -27,6 +27,9 @@ ! #endif + struct ysv *ysave; ++ #ifdef USE_ITHREADS ++ ENTER; /* force yydestruct() before we return */ ++ #endif + New(73, ysave, 1, struct ysv); + SAVEDESTRUCTOR_X(yydestruct, ysave); + ysave->oldyydebug = yydebug; @@ -42,7 +45,7 @@ yyn = *yys; *************** *** 1463,1468 **** ---- 1480,1495 ---- +--- 1483,1498 ---- yyerrflag = 0; yychar = (-1); @@ -68,7 +71,7 @@ } *++yyssp = yystate = yytable[yyn]; *++yyvsp = yylval; ---- 1520,1538 ---- +--- 1523,1541 ---- #endif if (yyssp >= yyss + yystacksize - 1) { @@ -97,7 +100,7 @@ } *++yyssp = yystate = yytable[yyn]; *++yyvsp = yylval; ---- 1573,1591 ---- +--- 1576,1594 ---- #endif if (yyssp >= yyss + yystacksize - 1) { @@ -134,7 +137,7 @@ yyaccept: ! return (0); } ---- 2524,2569 ---- +--- 2527,2575 ---- #endif if (yyssp >= yyss + yystacksize - 1) { @@ -160,6 +163,9 @@ yyabort: ! retval = 1; yyaccept: +! #ifdef USE_ITHREADS +! LEAVE; /* force yydestruct() before we return */ +! #endif ! return retval; ! } ! diff --git a/pp_ctl.c b/pp_ctl.c index 2060632..801f3f1 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -2634,11 +2634,9 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, AV** avp) /* switch to eval mode */ if (PL_curcop == &PL_compiling) { - SAVECOPSTASH(&PL_compiling); + SAVECOPSTASH_FREE(&PL_compiling); CopSTASH_set(&PL_compiling, PL_curstash); } - SAVECOPFILE(&PL_compiling); - SAVECOPLINE(&PL_compiling); if (PERLDB_NAMEEVAL && CopLINE(PL_curcop)) { SV *sv = sv_newmortal(); Perl_sv_setpvf(aTHX_ sv, "_<(%.10seval %lu)[%s:%"IVdf"]", @@ -2648,7 +2646,9 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, AV** avp) } else sprintf(tmpbuf, "_<(%.10s_eval %lu)", code, (unsigned long)++PL_evalseq); + SAVECOPFILE_FREE(&PL_compiling); CopFILE_set(&PL_compiling, tmpbuf+2); + SAVECOPLINE(&PL_compiling); CopLINE_set(&PL_compiling, 1); /* XXX For Cs within BEGIN {} blocks, this ends up deleting the eval's FILEGV from the stash before gv_check() runs @@ -3160,7 +3160,7 @@ trylocal: { } } } - SAVECOPFILE(&PL_compiling); + SAVECOPFILE_FREE(&PL_compiling); CopFILE_set(&PL_compiling, tryrsfp ? tryname : name); SvREFCNT_dec(namesv); if (!tryrsfp) { @@ -3270,7 +3270,6 @@ PP(pp_entereval) /* switch to eval mode */ - SAVECOPFILE(&PL_compiling); if (PERLDB_NAMEEVAL && CopLINE(PL_curcop)) { SV *sv = sv_newmortal(); Perl_sv_setpvf(aTHX_ sv, "_<(eval %lu)[%s:%"IVdf"]", @@ -3280,7 +3279,9 @@ PP(pp_entereval) } else sprintf(tmpbuf, "_<(eval %lu)", (unsigned long)++PL_evalseq); + SAVECOPFILE_FREE(&PL_compiling); CopFILE_set(&PL_compiling, tmpbuf+2); + SAVECOPLINE(&PL_compiling); CopLINE_set(&PL_compiling, 1); /* XXX For Cs within BEGIN {} blocks, this ends up deleting the eval's FILEGV from the stash before gv_check() runs diff --git a/proto.h b/proto.h index eb861e1..28c9581 100644 --- a/proto.h +++ b/proto.h @@ -651,6 +651,7 @@ PERL_CALLCONV void Perl_save_freesv(pTHX_ SV* sv); PERL_CALLCONV void Perl_save_freeop(pTHX_ OP* o); PERL_CALLCONV void Perl_save_freepv(pTHX_ char* pv); PERL_CALLCONV void Perl_save_generic_svref(pTHX_ SV** sptr); +PERL_CALLCONV void Perl_save_generic_pvref(pTHX_ char** str); PERL_CALLCONV void Perl_save_gp(pTHX_ GV* gv, I32 empty); PERL_CALLCONV HV* Perl_save_hash(pTHX_ GV* gv); PERL_CALLCONV void Perl_save_helem(pTHX_ HV* hv, SV *key, SV **sptr); diff --git a/scope.c b/scope.c index 3b9f0d1..0544b89 100644 --- a/scope.c +++ b/scope.c @@ -249,7 +249,7 @@ Perl_save_svref(pTHX_ SV **sptr) return save_scalar_at(sptr); } -/* Like save_svref(), but doesn't deal with magic. Can be used to +/* Like save_sptr(), but also SvREFCNT_dec()s the new value. Can be used to * restore a global SV to its prior contents, freeing new value. */ void Perl_save_generic_svref(pTHX_ SV **sptr) @@ -261,6 +261,19 @@ Perl_save_generic_svref(pTHX_ SV **sptr) SSPUSHINT(SAVEt_GENERIC_SVREF); } +/* Like save_pptr(), but also Safefree()s the new value if it is different + * from the old one. Can be used to restore a global char* to its prior + * contents, freeing new value. */ +void +Perl_save_generic_pvref(pTHX_ char **str) +{ + dTHR; + SSCHECK(3); + SSPUSHPTR(str); + SSPUSHPTR(*str); + SSPUSHINT(SAVEt_GENERIC_PVREF); +} + void Perl_save_gp(pTHX_ GV *gv, I32 empty) { @@ -646,6 +659,7 @@ Perl_leave_scope(pTHX_ I32 base) register AV *av; register HV *hv; register void* ptr; + register char* str; I32 i; if (base < -1) @@ -666,14 +680,20 @@ Perl_leave_scope(pTHX_ I32 base) ptr = &GvSV(gv); SvREFCNT_dec(gv); goto restore_sv; + case SAVEt_GENERIC_PVREF: /* generic pv */ + str = (char*)SSPOPPTR; + ptr = SSPOPPTR; + if (*(char**)ptr != str) { + Safefree(*(char**)ptr); + *(char**)ptr = str; + } + break; case SAVEt_GENERIC_SVREF: /* generic sv */ value = (SV*)SSPOPPTR; ptr = SSPOPPTR; - if (ptr) { - sv = *(SV**)ptr; - *(SV**)ptr = value; - SvREFCNT_dec(sv); - } + sv = *(SV**)ptr; + *(SV**)ptr = value; + SvREFCNT_dec(sv); SvREFCNT_dec(value); break; case SAVEt_SVREF: /* scalar reference */ diff --git a/scope.h b/scope.h index f33154a..e6a4209 100644 --- a/scope.h +++ b/scope.h @@ -32,6 +32,7 @@ #define SAVEt_VPTR 31 #define SAVEt_I8 32 #define SAVEt_COMPPAD 33 +#define SAVEt_GENERIC_PVREF 34 #define SSCHECK(need) if (PL_savestack_ix + need > PL_savestack_max) savestack_grow() #define SSPUSHINT(i) (PL_savestack[PL_savestack_ix++].any_i32 = (I32)(i)) @@ -105,6 +106,7 @@ Closing bracket on a callback. See C and L. #define SAVEFREEPV(p) save_freepv(SOFT_CAST(char*)(p)) #define SAVECLEARSV(sv) save_clearsv(SOFT_CAST(SV**)&(sv)) #define SAVEGENERICSV(s) save_generic_svref((SV**)&(s)) +#define SAVEGENERICPV(s) save_generic_pvref((char**)&(s)) #define SAVEDELETE(h,k,l) \ save_delete(SOFT_CAST(HV*)(h), SOFT_CAST(char*)(k), (I32)(l)) #define SAVEDESTRUCTOR(f,p) \ @@ -147,14 +149,18 @@ Closing bracket on a callback. See C and L. } STMT_END #ifdef USE_ITHREADS -# define SAVECOPSTASH(cop) SAVEPPTR(CopSTASHPV(cop)) -# define SAVECOPFILE(cop) SAVEPPTR(CopFILE(cop)) +# define SAVECOPSTASH(c) SAVEPPTR(CopSTASHPV(c)) +# define SAVECOPSTASH_FREE(c) SAVEGENERICPV(CopSTASHPV(c)) +# define SAVECOPFILE(c) SAVEPPTR(CopFILE(c)) +# define SAVECOPFILE_FREE(c) SAVEGENERICPV(CopFILE(c)) #else -# define SAVECOPSTASH(cop) SAVESPTR(CopSTASH(cop)) -# define SAVECOPFILE(cop) SAVESPTR(CopFILEGV(cop)) +# define SAVECOPSTASH(c) SAVESPTR(CopSTASH(c)) +# define SAVECOPSTASH_FREE(c) SAVECOPSTASH(c) /* XXX not refcounted */ +# define SAVECOPFILE(c) SAVESPTR(CopFILEGV(c)) +# define SAVECOPFILE_FREE(c) SAVEGENERICSV(CopFILEGV(c)) #endif -#define SAVECOPLINE(cop) SAVEI16(CopLINE(cop)) +#define SAVECOPLINE(c) SAVEI16(CopLINE(c)) /* SSNEW() temporarily allocates a specified number of bytes of data on the * savestack. It returns an integer index into the savestack, because a diff --git a/sv.c b/sv.c index 5517355..3254cfb 100644 --- a/sv.c +++ b/sv.c @@ -7152,6 +7152,12 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl) gv = (GV*)POPPTR(ss,ix); TOPPTR(nss,ix) = gv_dup_inc(gv); break; + case SAVEt_GENERIC_PVREF: /* generic char* */ + c = (char*)POPPTR(ss,ix); + TOPPTR(nss,ix) = pv_dup(c); + ptr = POPPTR(ss,ix); + TOPPTR(nss,ix) = any_dup(ptr, proto_perl); + break; case SAVEt_GENERIC_SVREF: /* generic sv */ case SAVEt_SVREF: /* scalar reference */ sv = (SV*)POPPTR(ss,ix); diff --git a/toke.c b/toke.c index 99c993e..70a7f53 100644 --- a/toke.c +++ b/toke.c @@ -502,8 +502,14 @@ S_incline(pTHX_ char *s) ch = *t; *t = '\0'; - if (t - s > 0) + if (t - s > 0) { +#ifdef USE_ITHREADS + Safefree(CopFILE(PL_curcop)); +#else + SvREFCNT_dec(CopFILEGV(PL_curcop)); +#endif CopFILE_set(PL_curcop, s); + } *t = ch; CopLINE_set(PL_curcop, atoi(n)-1); } @@ -2946,8 +2952,7 @@ Perl_yylex(pTHX) PL_expect = XTERM; TOKEN('('); case ';': - if (CopLINE(PL_curcop) < PL_copline) - PL_copline = CopLINE(PL_curcop); + CLINE; tmp = *s++; OPERATOR(tmp); case ')': diff --git a/vms/perly_c.vms b/vms/perly_c.vms index b17faea..0676ebd 100644 --- a/vms/perly_c.vms +++ b/vms/perly_c.vms @@ -1387,6 +1387,9 @@ yyparse() #endif struct ysv *ysave; +#ifdef USE_ITHREADS + ENTER; /* force yydestruct() before we return */ +#endif New(73, ysave, 1, struct ysv); SAVEDESTRUCTOR_X(yydestruct, ysave); ysave->oldyydebug = yydebug; @@ -2479,6 +2482,9 @@ yyoverflow: yyabort: retval = 1; yyaccept: +#ifdef USE_ITHREADS + LEAVE; /* force yydestruct() before we return */ +#endif return retval; }