X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FDevel%2FPeek%2FPeek.xs;h=a88d23141ddfcc7f31ee695aa6964ef04365ada6;hb=d04ba5897acce6425e3b231fbf36336ea42f8165;hp=312f5f84ba9995ba84bd85df6ea795d96a22d310;hpb=c024d977a3f66deece6fa8197092e1716641d48e;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/Devel/Peek/Peek.xs b/ext/Devel/Peek/Peek.xs index 312f5f8..a88d231 100644 --- a/ext/Devel/Peek/Peek.xs +++ b/ext/Devel/Peek/Peek.xs @@ -3,14 +3,26 @@ #include "perl.h" #include "XSUB.h" -SV * +static bool +_runops_debug(int flag) +{ + dTHX; + const bool d = PL_runops == MEMBER_TO_FPTR(Perl_runops_debug); + + if (flag >= 0) + PL_runops + = MEMBER_TO_FPTR(flag ? Perl_runops_debug : Perl_runops_standard); + return d; +} + +static SV * DeadCode(pTHX) { #ifdef PURIFY return Nullsv; #else SV* sva; - SV* sv, *dbg; + SV* sv; SV* ret = newRV_noinc((SV*)newAV()); register SV* svend; int tm = 0, tref = 0, ts = 0, ta = 0, tas = 0; @@ -27,7 +39,7 @@ DeadCode(pTHX) int levels, tots = 0, levela, tota = 0, levelas, totas = 0; int dumpit = 0; - if (CvXSUB(sv)) { + if (CvISXSUB(sv)) { continue; /* XSUB */ } if (!CvGV(sv)) { @@ -82,8 +94,6 @@ DeadCode(pTHX) } } else if (SvTYPE(pad[j]) >= SVt_PV && SvLEN(pad[j])) { - int db_len = SvLEN(pad[j]); - SV *db_sv = pad[j]; levels++; levelm += SvLEN(pad[j])/SvREFCNT(pad[j]); /* Dump(pad[j],4); */ @@ -117,16 +127,16 @@ DeadCode(pTHX) #endif /* !PURIFY */ } -#if defined(PERL_DEBUGGING_MSTATS) || defined(DEBUGGING_MSTATS) \ - || (defined(MYMALLOC) && !defined(PLAIN_MALLOC)) +#if (defined(PERL_DEBUGGING_MSTATS) || defined(DEBUGGING_MSTATS)) \ + && (defined(MYMALLOC) && !defined(PLAIN_MALLOC)) # define mstat(str) dump_mstats(str) #else # define mstat(str) \ PerlIO_printf(Perl_debug_log, "%s: perl not compiled with DEBUGGING_MSTATS\n",str); #endif -#if defined(PERL_DEBUGGING_MSTATS) || defined(DEBUGGING_MSTATS) \ - || (defined(MYMALLOC) && !defined(PLAIN_MALLOC)) +#if (defined(PERL_DEBUGGING_MSTATS) || defined(DEBUGGING_MSTATS)) \ + && (defined(MYMALLOC) && !defined(PLAIN_MALLOC)) /* Very coarse overestimate, 2-per-power-of-2, one more to determine NBUCKETS. */ # define _NBUCKETS (2*8*IVSIZE+1) @@ -137,7 +147,7 @@ struct mstats_buffer UV buf[_NBUCKETS*4]; }; -void +static void _fill_mstats(struct mstats_buffer *b, int level) { dTHX; @@ -149,12 +159,10 @@ _fill_mstats(struct mstats_buffer *b, int level) get_mstats(&(b->buffer), _NBUCKETS, level); } -void +static void fill_mstats(SV *sv, int level) { dTHX; - int nbuckets; - struct mstats_buffer buf; if (SvREADONLY(sv)) croak("Cannot modify a readonly value"); @@ -165,8 +173,8 @@ fill_mstats(SV *sv, int level) SvPOK_only(sv); } -void -_mstats_to_hv(HV *hv, struct mstats_buffer *b, int level) +static void +_mstats_to_hv(HV *hv, const struct mstats_buffer *b, int level) { dTHX; SV **svp; @@ -218,7 +226,7 @@ _mstats_to_hv(HV *hv, struct mstats_buffer *b, int level) warn("FIXME: internal mstats buffer too short"); for (type = 0; type < (level ? 4 : 2); type++) { - UV *p, *p1; + UV *p = 0, *p1 = 0; AV *av; int i; static const char *types[4] = { @@ -231,8 +239,8 @@ _mstats_to_hv(HV *hv, struct mstats_buffer *b, int level) croak("Unexpected value for the key '%s' in the mstats hash", types[type]); if (!SvOK(*svp)) { av = newAV(); - SvUPGRADE(*svp, SVt_RV); - SvRV(*svp) = (SV*)av; + (void)SvUPGRADE(*svp, SVt_RV); + SvRV_set(*svp, (SV*)av); SvROK_on(*svp); } else av = (AV*)SvRV(*svp); @@ -263,7 +271,8 @@ _mstats_to_hv(HV *hv, struct mstats_buffer *b, int level) } } } -void + +static void mstats_fillhash(SV *sv, int level) { struct mstats_buffer buf; @@ -273,7 +282,8 @@ mstats_fillhash(SV *sv, int level) _fill_mstats(&buf, level); _mstats_to_hv((HV *)SvRV(sv), &buf, level); } -void + +static void mstats2hash(SV *sv, SV *rv, int level) { if (!(SvROK(rv) && SvTYPE(SvRV(rv)) == SVt_PVHV)) @@ -285,17 +295,19 @@ mstats2hash(SV *sv, SV *rv, int level) _mstats_to_hv((HV *)SvRV(rv), (struct mstats_buffer*)SvPVX(sv), level); } #else /* !( defined(PERL_DEBUGGING_MSTATS) || defined(DEBUGGING_MSTATS) \ ) */ -void +static void fill_mstats(SV *sv, int level) { croak("Cannot report mstats without Perl malloc"); } -void + +static void mstats_fillhash(SV *sv, int level) { croak("Cannot report mstats without Perl malloc"); } -void + +static void mstats2hash(SV *sv, SV *rv, int level) { croak("Cannot report mstats without Perl malloc"); @@ -330,11 +342,12 @@ I32 lim PPCODE: { SV *pv_lim_sv = perl_get_sv("Devel::Peek::pv_limit", FALSE); - STRLEN pv_lim = pv_lim_sv ? SvIV(pv_lim_sv) : 0; + const STRLEN pv_lim = pv_lim_sv ? SvIV(pv_lim_sv) : 0; SV *dumpop = perl_get_sv("Devel::Peek::dump_ops", FALSE); - I32 save_dumpindent = PL_dumpindent; + const I32 save_dumpindent = PL_dumpindent; PL_dumpindent = 2; - do_sv_dump(0, Perl_debug_log, sv, 0, lim, dumpop && SvTRUE(dumpop), pv_lim); + do_sv_dump(0, Perl_debug_log, sv, 0, lim, + (bool)(dumpop && SvTRUE(dumpop)), pv_lim); PL_dumpindent = save_dumpindent; } @@ -345,14 +358,15 @@ PPCODE: { long i; SV *pv_lim_sv = perl_get_sv("Devel::Peek::pv_limit", FALSE); - STRLEN pv_lim = pv_lim_sv ? SvIV(pv_lim_sv) : 0; + const STRLEN pv_lim = pv_lim_sv ? SvIV(pv_lim_sv) : 0; SV *dumpop = perl_get_sv("Devel::Peek::dump_ops", FALSE); - I32 save_dumpindent = PL_dumpindent; + const I32 save_dumpindent = PL_dumpindent; PL_dumpindent = 2; for (i=1; i