X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=Size.xs;h=48b0ebf9756bbc66c9659146a144db3a2af5084e;hb=b76217297a5f92982c29177d97eb655b52d164eb;hp=4fd7559ea1bbeb38c126a8b4fb284b94a3a12c0c;hpb=b1e5ad85e1c05c8f9a3822664645476e0924ec3e;p=p5sagit%2FDevel-Size.git diff --git a/Size.xs b/Size.xs index 4fd7559..48b0ebf 100644 --- 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 *); @@ -151,7 +156,7 @@ static int go_yell = 1; 64-bit machines) bytes of the address as the string we're using as the key */ IV check_new(HV *tracking_hash, const void *thing) { - if (NULL == thing) { + if (NULL == thing || NULL == tracking_hash) { return FALSE; } if (hv_exists(tracking_hash, (char *)&thing, sizeof(void *))) { @@ -159,7 +164,6 @@ IV check_new(HV *tracking_hash, const 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 @@ -198,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; } @@ -216,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: @@ -265,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); } @@ -274,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 @@ -326,9 +334,18 @@ UV op_size(OP *baseop, HV *tracking_hash) { 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); @@ -384,46 +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 @@ -432,13 +475,14 @@ 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 */ - /* - 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 )); */ + 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... */ @@ -630,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); @@ -652,8 +701,9 @@ 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; @@ -668,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); @@ -684,24 +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)); - 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; + /* 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; @@ -725,6 +791,7 @@ CODE: break; case SVt_PVHV: + dbg_printf(("# Found type HV\n")); /* Is there anything in here? */ if (hv_iterinit((HV *)thing)) { HE *temp_he; @@ -735,6 +802,7 @@ CODE: 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)); @@ -760,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);