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 *);
return OPc_PADOP;
#endif
- if (o->op_type = OP_TRANS) {
+ if ((o->op_type = OP_TRANS)) {
return OPc_BASEOP;
}
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 *))) {
}
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
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;
}
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:
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);
}
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
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);
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:
/* 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 */
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
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))) {
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);
}
}
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 */
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);
{
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;
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);
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;
/* 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 */
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));
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);
projects / p5sagit/Devel-Size.git / blobdiff