X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=Size.xs;h=48b0ebf9756bbc66c9659146a144db3a2af5084e;hb=b76217297a5f92982c29177d97eb655b52d164eb;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..48b0ebf --- a/Size.xs +++ b/Size.xs @@ -5,6 +5,11 @@ static int regex_whine; static int fm_whine; +#if 0 && defined(DEBUGGING) +#define dbg_printf(x) printf x +#else +#define dbg_printf(x) +#endif #define carp puts UV thing_size(SV *, HV *); @@ -19,9 +24,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 +45,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,8 +155,8 @@ 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) { - if (NULL == thing) { +IV check_new(HV *tracking_hash, const void *thing) { + if (NULL == thing || NULL == tracking_hash) { return FALSE; } if (hv_exists(tracking_hash, (char *)&thing, sizeof(void *))) { @@ -156,7 +164,6 @@ IV check_new(HV *tracking_hash, void *thing) { } hv_store(tracking_hash, (char *)&thing, sizeof(void *), &PL_sv_yes, 0); return TRUE; - } /* Figure out how much magic is attached to the SV and return the @@ -195,12 +202,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 +225,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 +271,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 +281,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,15 +327,25 @@ UV op_size(OP *baseop, HV *tracking_hash) { total_size += op_size(cLOOPx(baseop)->op_lastop, tracking_hash); } */ + break; case OPc_COP: { COP *basecop; basecop = (COP *)baseop; total_size += sizeof(struct cop); + /* Change 33656 by nicholas@mouse-mill on 2008/04/07 11:29:51 + Eliminate cop_label from struct cop by storing a label as the first + entry in the hints hash. Most statements don't have labels, so this + will save memory. Not sure how much. + The check below will be incorrect fail on bleadperls + before 5.11 @33656, but later than 5.10, producing slightly too + small memory sizes on these Perls. */ +#if (PERL_VERSION < 11) if (check_new(tracking_hash, basecop->cop_label)) { total_size += strlen(basecop->cop_label); } +#endif #ifdef USE_ITHREADS if (check_new(tracking_hash, basecop->cop_file)) { total_size += strlen(basecop->cop_file); @@ -349,10 +370,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 +385,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 +401,72 @@ 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); +#if (PERL_VERSION < 11) + total_size += SvROK(thing) ? thing_size( SvRV(thing), tracking_hash) : SvLEN(thing); +#else total_size += SvLEN(thing); +#endif break; /* A string with an integer part? */ case SVt_PVIV: total_size += sizeof(XPVIV); +#if (PERL_VERSION < 11) + total_size += SvROK(thing) ? thing_size( SvRV(thing), tracking_hash) : SvLEN(thing); +#else total_size += SvLEN(thing); +#endif + 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); +#if (PERL_VERSION < 11) + total_size += SvROK(thing) ? thing_size( SvRV(thing), tracking_hash) : SvLEN(thing); +#else total_size += SvLEN(thing); +#endif break; case SVt_PVMG: total_size += sizeof(XPVMG); +#if (PERL_VERSION < 11) + total_size += SvROK(thing) ? thing_size( SvRV(thing), tracking_hash) : SvLEN(thing); +#else total_size += SvLEN(thing); +#endif total_size += magic_size(thing, tracking_hash); break; +#if PERL_VERSION <= 8 case SVt_PVBM: total_size += sizeof(XPVBM); +#if (PERL_VERSION < 11) + total_size += SvROK(thing) ? thing_size( SvRV(thing), tracking_hash) : SvLEN(thing); +#else total_size += SvLEN(thing); +#endif total_size += magic_size(thing, tracking_hash); break; +#endif case SVt_PVLV: total_size += sizeof(XPVLV); +#if (PERL_VERSION < 11) + total_size += SvROK(thing) ? thing_size( SvRV(thing), tracking_hash) : SvLEN(thing); +#else total_size += SvLEN(thing); +#endif total_size += magic_size(thing, tracking_hash); break; /* How much space is dedicated to the array? Not counting the @@ -415,10 +475,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); + dbg_printf(("total_size: %li AvMAX: %li av_len: $i\n", total_size, AvMAX(thing), av_len((AV*)thing))); } /* Add in the bits on the other side of the beginning */ - total_size += (sizeof(SV *) * (AvARRAY(thing) - AvALLOC(thing))); + + dbg_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 +569,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 +610,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 */ @@ -604,13 +674,18 @@ CODE: go_yell = SvIV(warn_flag); } - /* If they passed us a reference then dereference it. This is the only way we can check the sizes of arrays and hashes */ +#if (PERL_VERSION < 11) if (SvOK(thing) && SvROK(thing)) { thing = SvRV(thing); } - +#else + if (SvROK(thing)) { + thing = SvRV(thing); + } +#endif + RETVAL = thing_size(thing, tracking_hash); /* Clean up after ourselves */ SvREFCNT_dec(tracking_hash); @@ -626,13 +701,12 @@ CODE: { SV *thing = orig_thing; /* Hash to track our seen pointers */ - HV *tracking_hash = newHV(); - AV *pending_array = newAV(); + HV *tracking_hash; + /* Array with things we still need to do */ + AV *pending_array; IV size = 0; SV *warn_flag; - IV count = 0; - /* Size starts at zero */ RETVAL = 0; @@ -644,13 +718,18 @@ CODE: if (NULL != (warn_flag = perl_get_sv("Devel::Size::warn", FALSE))) { go_yell = SvIV(warn_flag); } - - /* If they passed us a reference then dereference it. This is the - only way we can check the sizes of arrays and hashes */ - if (SvOK(thing) && SvROK(thing)) { - thing = SvRV(thing); - } + /* init these after the go_yell above */ + tracking_hash = newHV(); + pending_array = newAV(); + + /* We cannot push HV/AV directly, only the RV. So deref it + later (see below for "*** dereference later") and adjust here for + the miscalculation. + This is the only way we can check the sizes of arrays and hashes. */ + if (SvROK(thing)) { + RETVAL -= thing_size(thing, NULL); + } /* Put it on the pending array */ av_push(pending_array, thing); @@ -660,16 +739,35 @@ CODE: thing = av_pop(pending_array); /* Process it if we've not seen it */ if (check_new(tracking_hash, thing)) { + dbg_printf(("# Found type %i at %p\n", SvTYPE(thing), thing)); /* Is it valid? */ if (thing) { /* Yes, it is. So let's check the type */ switch (SvTYPE(thing)) { - case SVt_RV: - av_push(pending_array, SvRV(thing)); + /* 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; + /* this is the "*** dereference later" part - see above */ +#if (PERL_VERSION < 11) + case SVt_RV: +#else + case SVt_IV: +#endif + dbg_printf(("# Found RV\n")); + if (SvROK(thing)) { + dbg_printf(("# Found RV\n")); + av_push(pending_array, SvRV(thing)); + } + break; + case SVt_PVAV: { + dbg_printf(("# Found type AV\n")); /* Quick alias to cut down on casting */ AV *tempAV = (AV *)thing; SV **tempSV; @@ -680,7 +778,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 */ @@ -693,16 +791,18 @@ CODE: break; case SVt_PVHV: + dbg_printf(("# Found type HV\n")); /* 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)); } } break; case SVt_PVGV: + dbg_printf(("# Found type GV\n")); /* Run through all the pieces and push the ones with bits */ if (GvSV(thing)) { av_push(pending_array, (SV *)GvSV(thing)); @@ -728,8 +828,14 @@ CODE: size = thing_size(thing, tracking_hash); RETVAL += size; + } else { + /* check_new() returned false: */ +#ifdef DEVEL_SIZE_DEBUGGING + if (SvOK(sv)) printf("# Ignore ref copy 0x%x\n", sv); + else printf("# Ignore non-sv 0x%x\n", sv); +#endif } - } + } /* end while */ /* Clean up after ourselves */ SvREFCNT_dec(tracking_hash);