#include "perl.h"
#include "XSUB.h"
+#define carp puts
+
#if !defined(NV)
#define NV double
#endif
-UV thing_size(SV *orig_thing) {
+static int go_yell = 1;
+
+/* Checks to see if thing is in the hash. Returns true or false, and
+ notes thing in the hash.
+
+ This code does one Evil Thing. Since we're tracking pointers, we
+ tell perl that the string key is the address in the pointer. We do this by
+ passing in the address of the address, along with the size of a
+ 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 (hv_exists(tracking_hash, (char *)&thing, sizeof(void *))) {
+ return FALSE;
+ }
+ 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
+ size */
+IV magic_size(SV *thing, HV *tracking_hash) {
+ IV total_size = 0;
+ MAGIC *magic_pointer;
+
+ /* Is there any? */
+ if (!SvMAGIC(thing)) {
+ /* No, bail */
+ return 0;
+ }
+
+ /* Get the base magic pointer */
+ magic_pointer = SvMAGIC(thing);
+
+ /* Have we seen the magic pointer? */
+ while (magic_pointer && check_new(tracking_hash, magic_pointer)) {
+ total_size += sizeof(MAGIC);
+
+ /* Have we seen the magic vtable? */
+ if (magic_pointer->mg_virtual &&
+ check_new(tracking_hash, magic_pointer->mg_virtual)) {
+ total_size += sizeof(MGVTBL);
+ }
+
+ /* Get the next in the chain */
+ magic_pointer = magic_pointer->mg_moremagic;
+ }
+
+ return total_size;
+}
+
+
+UV thing_size(SV *orig_thing, HV *tracking_hash) {
SV *thing = orig_thing;
UV total_size = sizeof(SV);
- /* 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);
- }
-
switch (SvTYPE(thing)) {
/* Is it undef? */
case SVt_NULL:
total_size += SvLEN(thing);
break;
case SVt_PVMG:
- croak("Not yet");
+ total_size += sizeof(XPVMG);
+ total_size += SvLEN(thing);
+ total_size += magic_size(thing, tracking_hash);
break;
case SVt_PVBM:
- croak("Not yet");
+ total_size += sizeof(XPVBM);
+ total_size += SvLEN(thing);
+ total_size += magic_size(thing, tracking_hash);
break;
case SVt_PVLV:
- croak("Not yet");
+ total_size += sizeof(XPVLV);
+ total_size += SvLEN(thing);
+ total_size += magic_size(thing, tracking_hash);
break;
/* How much space is dedicated to the array? Not counting the
elements in the array, mind, just the array itself */
total_size += (sizeof(SV *) * (AvARRAY(thing) - AvALLOC(thing)));
/* Is there something hanging off the arylen element? */
if (AvARYLEN(thing)) {
- total_size += thing_size(AvARYLEN(thing));
+ if (check_new(tracking_hash, AvARYLEN(thing))) {
+ total_size += thing_size(AvARYLEN(thing), tracking_hash);
+ }
}
+ total_size += magic_size(thing, tracking_hash);
break;
case SVt_PVHV:
/* First the base struct */
/* Now the array of buckets */
total_size += (sizeof(HE *) * (HvMAX(thing) + 1));
/* Now walk the bucket chain */
- {
+ if (HvARRAY(thing)) {
HE *cur_entry;
IV cur_bucket = 0;
- puts("Foo!");
for (cur_bucket = 0; cur_bucket <= HvMAX(thing); cur_bucket++) {
cur_entry = *(HvARRAY(thing) + cur_bucket);
while (cur_entry) {
total_size += sizeof(HE);
if (cur_entry->hent_hek) {
- total_size += sizeof(HEK);
- total_size += cur_entry->hent_hek->hek_len - 1;
+ /* Hash keys can be shared. Have we seen this before? */
+ if (check_new(tracking_hash, cur_entry->hent_hek)) {
+ total_size += HEK_BASESIZE + cur_entry->hent_hek->hek_len + 2;
+ }
}
cur_entry = cur_entry->hent_next;
}
}
}
+ total_size += magic_size(thing, tracking_hash);
break;
case SVt_PVCV:
- croak("Not yet");
+ total_size += sizeof(XPVCV);
+ total_size += magic_size(thing, tracking_hash);
+ if (go_yell) {
+ carp("Devel::Size: Calculated sizes for CVs are incomplete");
+ }
break;
case SVt_PVGV:
- croak("Not yet");
+ total_size += magic_size(thing, tracking_hash);
+ total_size += sizeof(XPVGV);
+ total_size += GvNAMELEN(thing);
+#ifdef GvFILE
+ /* Is there a file? */
+ if (GvFILE(thing)) {
+ if (check_new(tracking_hash, GvFILE(thing))) {
+ total_size += strlen(GvFILE(thing));
+ }
+ }
+#endif
+ /* Is there something hanging off the glob? */
+ if (GvGP(thing)) {
+ if (check_new(tracking_hash, GvGP(thing))) {
+ total_size += sizeof(GP);
+ {
+ SV *generic_thing;
+ if (generic_thing = (SV *)(GvGP(thing)->gp_sv)) {
+ total_size += thing_size(generic_thing, tracking_hash);
+ }
+ if (generic_thing = (SV *)(GvGP(thing)->gp_form)) {
+ total_size += thing_size(generic_thing, tracking_hash);
+ }
+ if (generic_thing = (SV *)(GvGP(thing)->gp_av)) {
+ total_size += thing_size(generic_thing, tracking_hash);
+ }
+ if (generic_thing = (SV *)(GvGP(thing)->gp_hv)) {
+ total_size += thing_size(generic_thing, tracking_hash);
+ }
+ if (generic_thing = (SV *)(GvGP(thing)->gp_egv)) {
+ total_size += thing_size(generic_thing, tracking_hash);
+ }
+ if (generic_thing = (SV *)(GvGP(thing)->gp_cv)) {
+ total_size += thing_size(generic_thing, tracking_hash);
+ }
+ }
+ }
+ }
break;
case SVt_PVFM:
- croak("Not yet");
+ total_size += sizeof(XPVFM);
+ if (go_yell) {
+ carp("Devel::Size: Calculated sizes for FMs are incomplete");
+ }
break;
case SVt_PVIO:
- croak("Not yet");
+ total_size += sizeof(XPVIO);
+ total_size += magic_size(thing, tracking_hash);
+ if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xpv_pv)) {
+ total_size += ((XPVIO *) SvANY(thing))->xpv_cur;
+ }
+ /* Some embedded char pointers */
+ if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xio_top_name)) {
+ total_size += strlen(((XPVIO *) SvANY(thing))->xio_top_name);
+ }
+ if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xio_fmt_name)) {
+ total_size += strlen(((XPVIO *) SvANY(thing))->xio_fmt_name);
+ }
+ if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xio_bottom_name)) {
+ total_size += strlen(((XPVIO *) SvANY(thing))->xio_bottom_name);
+ }
+ /* Throw the GVs on the list to be walked if they're not-null */
+ if (((XPVIO *) SvANY(thing))->xio_top_gv) {
+ total_size += thing_size((SV *)((XPVIO *) SvANY(thing))->xio_top_gv,
+ tracking_hash);
+ }
+ if (((XPVIO *) SvANY(thing))->xio_bottom_gv) {
+ total_size += thing_size((SV *)((XPVIO *) SvANY(thing))->xio_bottom_gv,
+ tracking_hash);
+ }
+ if (((XPVIO *) SvANY(thing))->xio_fmt_gv) {
+ total_size += thing_size((SV *)((XPVIO *) SvANY(thing))->xio_fmt_gv,
+ tracking_hash);
+ }
+
+ /* Only go trotting through the IO structures if they're really
+ trottable. If USE_PERLIO is defined we can do this. If
+ not... we can't, so we don't even try */
+#ifdef USE_PERLIO
+ /* Dig into xio_ifp and xio_ofp here */
+ croak("Devel::Size: Can't size up perlio layers yet");
+#endif
break;
default:
- croak("Unknown variable type");
+ croak("Devel::Size: Unknown variable type");
}
return total_size;
}
-
MODULE = Devel::Size PACKAGE = Devel::Size
+PROTOTYPES: DISABLE
+
IV
size(orig_thing)
SV *orig_thing
CODE:
{
- RETVAL = thing_size(orig_thing);
+ SV *thing = orig_thing;
+ /* Hash to track our seen pointers */
+ HV *tracking_hash = newHV();
+ SV *warn_flag;
+
+ /* Check warning status */
+ go_yell = 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);
+ }
+
+ RETVAL = thing_size(thing, tracking_hash);
+ /* Clean up after ourselves */
+ SvREFCNT_dec(tracking_hash);
}
OUTPUT:
RETVAL
+
+
+IV
+total_size(orig_thing)
+ SV *orig_thing
+CODE:
+{
+ SV *thing = orig_thing;
+ /* Hash to track our seen pointers */
+ HV *tracking_hash = newHV();
+ AV *pending_array = newAV();
+ IV size = 0;
+ SV *warn_flag;
+
+ IV count = 0;
+
+ /* Size starts at zero */
+ RETVAL = 0;
+
+ /* Check warning status */
+ go_yell = 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);
+ }
+
+ /* Put it on the pending array */
+ av_push(pending_array, thing);
+
+ /* Now just yank things off the end of the array until it's done */
+ while (av_len(pending_array) >= 0) {
+ thing = av_pop(pending_array);
+ /* Process it if we've not seen it */
+ if (check_new(tracking_hash, 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;
+
+ case SVt_PVAV:
+ {
+ /* Quick alias to cut down on casting */
+ AV *tempAV = (AV *)thing;
+ SV **tempSV;
+
+ /* Any elements? */
+ if (av_len(tempAV) != -1) {
+ IV index;
+ /* Run through them all */
+ for (index = 0; index <= av_len(tempAV); index++) {
+ /* Did we get something? */
+ if (tempSV = av_fetch(tempAV, index, 0)) {
+ /* Was it undef? */
+ if (*tempSV != &PL_sv_undef) {
+ /* Apparently not. Save it for later */
+ av_push(pending_array, *tempSV);
+ }
+ }
+ }
+ }
+ }
+ break;
+
+ case SVt_PVHV:
+ /* Is there anything in here? */
+ if (hv_iterinit((HV *)thing)) {
+ HE *temp_he;
+ while (temp_he = hv_iternext((HV *)thing)) {
+ av_push(pending_array, hv_iterval((HV *)thing, temp_he));
+ }
+ }
+ break;
+
+ case SVt_PVGV:
+ /* Run through all the pieces and push the ones with bits */
+ if (GvSV(thing)) {
+ av_push(pending_array, (SV *)GvSV(thing));
+ }
+ if (GvFORM(thing)) {
+ av_push(pending_array, (SV *)GvFORM(thing));
+ }
+ if (GvAV(thing)) {
+ av_push(pending_array, (SV *)GvAV(thing));
+ }
+ if (GvHV(thing)) {
+ av_push(pending_array, (SV *)GvHV(thing));
+ }
+ if (GvCV(thing)) {
+ av_push(pending_array, (SV *)GvCV(thing));
+ }
+ break;
+ default:
+ break;
+ }
+ }
+
+
+ size = thing_size(thing, tracking_hash);
+ RETVAL += size;
+ }
+ }
+
+ /* Clean up after ourselves */
+ SvREFCNT_dec(tracking_hash);
+ SvREFCNT_dec(pending_array);
+}
+OUTPUT:
+ RETVAL
+
projects / p5sagit/Devel-Size.git / blobdiff