X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=Size.xs;h=c69c3489b83449fdf4cd0aefbb5fa294f0727779;hb=6ea94d90d77e87b84ee176b42cce067047362a4c;hp=bd1b20cde8cd228668fd9c21e03810fab89a7c60;hpb=98ecbbc6c212eef2620e62ec70db99bd81160683;p=p5sagit%2FDevel-Size.git diff --git a/Size.xs b/Size.xs old mode 100755 new mode 100644 index bd1b20c..c69c348 --- a/Size.xs +++ b/Size.xs @@ -19,9 +19,8 @@ typedef enum { OPc_SVOP, /* 7 */ OPc_PADOP, /* 8 */ OPc_PVOP, /* 9 */ - OPc_CVOP, /* 10 */ - OPc_LOOP, /* 11 */ - OPc_COP /* 12 */ + OPc_LOOP, /* 10 */ + OPc_COP /* 11 */ } opclass; static opclass @@ -41,6 +40,10 @@ cc_opclass(OP *o) return OPc_PADOP; #endif + if ((o->op_type = OP_TRANS)) { + return OPc_BASEOP; + } + switch (PL_opargs[o->op_type] & OA_CLASS_MASK) { case OA_BASEOP: return OPc_BASEOP; @@ -147,7 +150,7 @@ static int go_yell = 1; pointer as the length. Perl then uses the four (or eight, on 64-bit machines) bytes of the address as the string we're using as the key */ -IV check_new(HV *tracking_hash, void *thing) { +IV check_new(HV *tracking_hash, const void *thing) { if (NULL == thing) { return FALSE; } @@ -195,12 +198,17 @@ UV regex_size(REGEXP *baseregex, HV *tracking_hash) { UV total_size = 0; total_size += sizeof(REGEXP); - /* Note hte size of the paren offset thing */ +#if (PERL_VERSION < 11) + /* Note the size of the paren offset thing */ total_size += sizeof(I32) * baseregex->nparens * 2; total_size += strlen(baseregex->precomp); - +#else + total_size += sizeof(struct regexp); + total_size += sizeof(I32) * SvANY(baseregex)->nparens * 2; + /*total_size += strlen(SvANY(baseregex)->subbeg);*/ +#endif if (go_yell && !regex_whine) { - carp("Devel::Size: Calculated sizes for compiled regexes are incomple, and probably always will be"); + carp("Devel::Size: Calculated sizes for compiled regexes are incompatible, and probably always will be"); regex_whine = 1; } @@ -213,9 +221,6 @@ UV op_size(OP *baseop, HV *tracking_hash) { if (check_new(tracking_hash, baseop->op_next)) { total_size += op_size(baseop->op_next, tracking_hash); } - if (check_new(tracking_hash, baseop->op_next)) { - total_size += op_size(baseop->op_next, tracking_hash); - } switch (cc_opclass(baseop)) { case OPc_BASEOP: @@ -262,6 +267,7 @@ UV op_size(OP *baseop, HV *tracking_hash) { if (check_new(tracking_hash, cPMOPx(baseop)->op_last)) { total_size += op_size(cPMOPx(baseop)->op_last, tracking_hash); } +#if PERL_VERSION < 9 || (PERL_VERSION == 9 && PERL_SUBVERSION < 5) if (check_new(tracking_hash, cPMOPx(baseop)->op_pmreplroot)) { total_size += op_size(cPMOPx(baseop)->op_pmreplroot, tracking_hash); } @@ -271,6 +277,7 @@ UV op_size(OP *baseop, HV *tracking_hash) { if (check_new(tracking_hash, cPMOPx(baseop)->op_pmnext)) { total_size += op_size((OP *)cPMOPx(baseop)->op_pmnext, tracking_hash); } +#endif /* This is defined away in perl 5.8.x, but it is in there for 5.6.x */ #ifdef PM_GETRE @@ -316,6 +323,7 @@ UV op_size(OP *baseop, HV *tracking_hash) { total_size += op_size(cLOOPx(baseop)->op_lastop, tracking_hash); } */ + break; case OPc_COP: { COP *basecop; @@ -349,10 +357,14 @@ UV op_size(OP *baseop, HV *tracking_hash) { return total_size; } +#if PERL_VERSION > 9 || (PERL_VERSION == 9 && PERL_SUBVERSION > 2) +# define NEW_HEAD_LAYOUT +#endif + UV thing_size(SV *orig_thing, HV *tracking_hash) { SV *thing = orig_thing; UV total_size = sizeof(SV); - + switch (SvTYPE(thing)) { /* Is it undef? */ case SVt_NULL: @@ -360,10 +372,12 @@ UV thing_size(SV *orig_thing, HV *tracking_hash) { /* Just a plain integer. This will be differently sized depending on whether purify's been compiled in */ case SVt_IV: -#ifdef PURIFY +#ifndef NEW_HEAD_LAYOUT +# ifdef PURIFY total_size += sizeof(sizeof(XPVIV)); -#else +# else total_size += sizeof(IV); +# endif #endif break; /* Is it a float? Like the int, it depends on purify */ @@ -374,39 +388,48 @@ UV thing_size(SV *orig_thing, HV *tracking_hash) { total_size += sizeof(NV); #endif break; +#if (PERL_VERSION < 11) /* Is it a reference? */ case SVt_RV: +#ifndef NEW_HEAD_LAYOUT total_size += sizeof(XRV); +#endif break; +#endif /* How about a plain string? In which case we need to add in how much has been allocated */ case SVt_PV: total_size += sizeof(XPV); - total_size += SvLEN(thing); + total_size += SvROK(thing) ? thing_size( SvRV(thing), tracking_hash) : SvLEN(thing); break; /* A string with an integer part? */ case SVt_PVIV: total_size += sizeof(XPVIV); - total_size += SvLEN(thing); + total_size += SvROK(thing) ? thing_size( SvRV(thing), tracking_hash) : SvLEN(thing); + if(SvOOK(thing)) { + total_size += SvIVX(thing); + } break; - /* A string with a float part? */ + /* A scalar/string/reference with a float part? */ case SVt_PVNV: total_size += sizeof(XPVNV); - total_size += SvLEN(thing); + total_size += SvROK(thing) ? thing_size( SvRV(thing), tracking_hash) : SvLEN(thing); break; case SVt_PVMG: total_size += sizeof(XPVMG); - total_size += SvLEN(thing); + total_size += SvROK(thing) ? thing_size( SvRV(thing), tracking_hash) : SvLEN(thing); total_size += magic_size(thing, tracking_hash); break; +#if PERL_VERSION <= 8 case SVt_PVBM: total_size += sizeof(XPVBM); - total_size += SvLEN(thing); + total_size += SvROK(thing) ? thing_size( SvRV(thing), tracking_hash) : SvLEN(thing); total_size += magic_size(thing, tracking_hash); break; +#endif case SVt_PVLV: total_size += sizeof(XPVLV); - total_size += SvLEN(thing); + total_size += SvROK(thing) ? thing_size( SvRV(thing), tracking_hash) : SvLEN(thing); total_size += magic_size(thing, tracking_hash); break; /* How much space is dedicated to the array? Not counting the @@ -415,10 +438,20 @@ UV thing_size(SV *orig_thing, HV *tracking_hash) { total_size += sizeof(XPVAV); /* Is there anything in the array? */ if (AvMAX(thing) != -1) { - total_size += sizeof(SV *) * AvMAX(thing); + /* an array with 10 slots has AvMax() set to 9 - te 2007-04-22 */ + total_size += sizeof(SV *) * (AvMAX(thing) + 1); + /* printf ("total_size: %li AvMAX: %li av_len: %i\n", total_size, AvMAX(thing), av_len(thing)); */ } /* Add in the bits on the other side of the beginning */ - total_size += (sizeof(SV *) * (AvARRAY(thing) - AvALLOC(thing))); + + /* printf ("total_size %li, sizeof(SV *) %li, AvARRAY(thing) %li, AvALLOC(thing)%li , sizeof(ptr) %li \n", + total_size, sizeof(SV*), AvARRAY(thing), AvALLOC(thing), sizeof( thing )); */ + + /* under Perl 5.8.8 64bit threading, AvARRAY(thing) was a pointer while AvALLOC was 0, + resulting in grossly overstated sized for arrays. Technically, this shouldn't happen... */ + if (AvALLOC(thing) != 0) { + total_size += (sizeof(SV *) * (AvARRAY(thing) - AvALLOC(thing))); + } /* Is there something hanging off the arylen element? */ if (AvARYLEN(thing)) { if (check_new(tracking_hash, AvARYLEN(thing))) { @@ -499,22 +532,22 @@ UV thing_size(SV *orig_thing, HV *tracking_hash) { total_size += sizeof(GP); { SV *generic_thing; - if (generic_thing = (SV *)(GvGP(thing)->gp_sv)) { + if ((generic_thing = (SV *)(GvGP(thing)->gp_sv))) { total_size += thing_size(generic_thing, tracking_hash); } - if (generic_thing = (SV *)(GvGP(thing)->gp_form)) { + if ((generic_thing = (SV *)(GvGP(thing)->gp_form))) { total_size += thing_size(generic_thing, tracking_hash); } - if (generic_thing = (SV *)(GvGP(thing)->gp_av)) { + if ((generic_thing = (SV *)(GvGP(thing)->gp_av))) { total_size += thing_size(generic_thing, tracking_hash); } - if (generic_thing = (SV *)(GvGP(thing)->gp_hv)) { + if ((generic_thing = (SV *)(GvGP(thing)->gp_hv))) { total_size += thing_size(generic_thing, tracking_hash); } - if (generic_thing = (SV *)(GvGP(thing)->gp_egv)) { + if ((generic_thing = (SV *)(GvGP(thing)->gp_egv))) { total_size += thing_size(generic_thing, tracking_hash); } - if (generic_thing = (SV *)(GvGP(thing)->gp_cv)) { + if ((generic_thing = (SV *)(GvGP(thing)->gp_cv))) { total_size += thing_size(generic_thing, tracking_hash); } } @@ -540,7 +573,7 @@ UV thing_size(SV *orig_thing, HV *tracking_hash) { case SVt_PVIO: total_size += sizeof(XPVIO); total_size += magic_size(thing, tracking_hash); - if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xpv_pv)) { + if (check_new(tracking_hash, (SvPVX(thing)))) { total_size += ((XPVIO *) SvANY(thing))->xpv_cur; } /* Some embedded char pointers */ @@ -631,8 +664,6 @@ CODE: IV size = 0; SV *warn_flag; - IV count = 0; - /* Size starts at zero */ RETVAL = 0; @@ -662,12 +693,22 @@ CODE: if (check_new(tracking_hash, thing)) { /* Is it valid? */ if (thing) { + /* printf ("Found type %i at %p\n", SvTYPE(thing), thing); */ + /* Yes, it is. So let's check the type */ switch (SvTYPE(thing)) { case SVt_RV: av_push(pending_array, SvRV(thing)); break; + /* fix for bug #24846 (Does not correctly recurse into references in a PVNV-type scalar) */ + case SVt_PVNV: + if (SvROK(thing)) + { + av_push(pending_array, SvRV(thing)); + } + break; + case SVt_PVAV: { /* Quick alias to cut down on casting */ @@ -680,7 +721,7 @@ CODE: /* Run through them all */ for (index = 0; index <= av_len(tempAV); index++) { /* Did we get something? */ - if (tempSV = av_fetch(tempAV, index, 0)) { + if ((tempSV = av_fetch(tempAV, index, 0))) { /* Was it undef? */ if (*tempSV != &PL_sv_undef) { /* Apparently not. Save it for later */ @@ -696,7 +737,7 @@ CODE: /* Is there anything in here? */ if (hv_iterinit((HV *)thing)) { HE *temp_he; - while (temp_he = hv_iternext((HV *)thing)) { + while ((temp_he = hv_iternext((HV *)thing))) { av_push(pending_array, hv_iterval((HV *)thing, temp_he)); } }