Size.xs

   1 #include "EXTERN.h"
   2 #include "perl.h"
   3 #include "XSUB.h"
   4
   5 #define carp puts
   6
   7 #if !defined(NV)
   8 #define NV double
   9 #endif
  10
  11 /* Checks to see if thing is in the hash. Returns true or false, and
  12    notes thing in the hash.
  13
  14    This code does one Evil Thing. Since we're tracking pointers, we
  15    tell perl that the string key is the address in the pointer. We do this by
  16    passing in the address of the address, along with the size of a
  17    pointer as the length. Perl then uses the four (or eight, on
  18    64-bit machines) bytes of the address as the string we're using as
  19    the key */
  20 IV check_new(HV *tracking_hash, void *thing) {
  21   if (hv_exists(tracking_hash, (char *)&thing, sizeof(void *))) {
  22     return FALSE;
  23   }
  24   hv_store(tracking_hash, (char *)&thing, sizeof(void *), &PL_sv_undef, 0);
  25   return TRUE;
  26
  27 }
  28
  29 /* Figure out how much magic is attached to the SV and return the
  30    size */
  31 IV magic_size(SV *thing, HV *tracking_hash) {
  32   IV total_size = 0;
  33   MAGIC *magic_pointer;
  34
  35   /* Is there any? */
  36   if (!SvMAGIC(thing)) {
  37     /* No, bail */
  38     return 0;
  39   }
  40
  41   /* Get the base magic pointer */
  42   magic_pointer = SvMAGIC(thing);
  43
  44   /* Have we seen the magic pointer? */
  45   while (magic_pointer && check_new(tracking_hash, magic_pointer)) {
  46     total_size += sizeof(MAGIC);
  47
  48     /* Have we seen the magic vtable? */
  49     if (magic_pointer->mg_virtual &&
  50         check_new(tracking_hash, magic_pointer->mg_virtual)) {
  51       total_size += sizeof(MGVTBL);
  52     }
  53
  54     /* Get the next in the chain */
  55     magic_pointer = magic_pointer->mg_moremagic;
  56   }
  57
  58   return total_size;
  59 }
  60
  61
  62 UV thing_size(SV *orig_thing, HV *tracking_hash) {
  63   SV *thing = orig_thing;
  64   UV total_size = sizeof(SV);
  65
  66   switch (SvTYPE(thing)) {
  67     /* Is it undef? */
  68   case SVt_NULL:
  69     break;
  70     /* Just a plain integer. This will be differently sized depending
  71        on whether purify's been compiled in */
  72   case SVt_IV:
  73 #ifdef PURIFY
  74     total_size += sizeof(sizeof(XPVIV));
  75 #else
  76     total_size += sizeof(IV);
  77 #endif
  78     break;
  79     /* Is it a float? Like the int, it depends on purify */
  80   case SVt_NV:
  81 #ifdef PURIFY
  82     total_size += sizeof(sizeof(XPVNV));
  83 #else
  84     total_size += sizeof(NV);
  85 #endif
  86     break;
  87     /* Is it a reference? */
  88   case SVt_RV:
  89     total_size += sizeof(XRV);
  90     break;
  91     /* How about a plain string? In which case we need to add in how
  92        much has been allocated */
  93   case SVt_PV:
  94     total_size += sizeof(XPV);
  95     total_size += SvLEN(thing);
  96     break;
  97     /* A string with an integer part? */
  98   case SVt_PVIV:
  99     total_size += sizeof(XPVIV);
 100     total_size += SvLEN(thing);
 101     break;
 102     /* A string with a float part? */
 103   case SVt_PVNV:
 104     total_size += sizeof(XPVNV);
 105     total_size += SvLEN(thing);
 106     break;
 107   case SVt_PVMG:
 108     total_size += sizeof(XPVMG);
 109     total_size += SvLEN(thing);
 110     total_size += magic_size(thing, tracking_hash);
 111     break;
 112   case SVt_PVBM:
 113     total_size += sizeof(XPVBM);
 114     total_size += SvLEN(thing);
 115     total_size += magic_size(thing, tracking_hash);
 116     break;
 117   case SVt_PVLV:
 118     total_size += sizeof(XPVLV);
 119     total_size += SvLEN(thing);
 120     total_size += magic_size(thing, tracking_hash);
 121     break;
 122     /* How much space is dedicated to the array? Not counting the
 123        elements in the array, mind, just the array itself */
 124   case SVt_PVAV:
 125     total_size += sizeof(XPVAV);
 126     /* Is there anything in the array? */
 127     if (AvMAX(thing) != -1) {
 128       total_size += sizeof(SV *) * AvMAX(thing);
 129     }
 130     /* Add in the bits on the other side of the beginning */
 131     total_size += (sizeof(SV *) * (AvARRAY(thing) - AvALLOC(thing)));
 132     /* Is there something hanging off the arylen element? */
 133     if (AvARYLEN(thing)) {
 134       if (check_new(tracking_hash, AvARYLEN(thing))) {
 135         total_size += thing_size(AvARYLEN(thing), tracking_hash);
 136       }
 137     }
 138     total_size += magic_size(thing, tracking_hash);
 139     break;
 140   case SVt_PVHV:
 141     /* First the base struct */
 142     total_size += sizeof(XPVHV);
 143     /* Now the array of buckets */
 144     total_size += (sizeof(HE *) * (HvMAX(thing) + 1));
 145     /* Now walk the bucket chain */
 146     if (HvARRAY(thing)) {
 147       HE *cur_entry;
 148       IV cur_bucket = 0;
 149       for (cur_bucket = 0; cur_bucket <= HvMAX(thing); cur_bucket++) {
 150         cur_entry = *(HvARRAY(thing) + cur_bucket);
 151         while (cur_entry) {
 152           total_size += sizeof(HE);
 153           if (cur_entry->hent_hek) {
 154             /* Hash keys can be shared. Have we seen this before? */
 155             if (check_new(tracking_hash, cur_entry->hent_hek)) {
 156               total_size += sizeof(HEK);
 157               total_size += cur_entry->hent_hek->hek_len - 1;
 158             }
 159           }
 160           cur_entry = cur_entry->hent_next;
 161         }
 162       }
 163     }
 164     total_size += magic_size(thing, tracking_hash);
 165     break;
 166   case SVt_PVCV:
 167     total_size += sizeof(XPVCV);
 168     total_size += magic_size(thing, tracking_hash);
 169     carp("CV isn't complete");
 170     break;
 171   case SVt_PVGV:
 172     total_size += magic_size(thing, tracking_hash);
 173     total_size += sizeof(XPVGV);
 174     total_size += GvNAMELEN(thing);
 175     /* Is there a file? */
 176     if (GvFILE(thing)) {
 177       if (check_new(tracking_hash, GvFILE(thing))) {
 178         total_size += strlen(GvFILE(thing));
 179       }
 180     }
 181     /* Is there something hanging off the glob? */
 182     if (GvGP(thing)) {
 183       if (check_new(tracking_hash, GvGP(thing))) {
 184         total_size += sizeof(GP);
 185       }
 186     }
 187     break;
 188   case SVt_PVFM:
 189     total_size += sizeof(XPVFM);
 190     carp("FM isn't complete");
 191     break;
 192   case SVt_PVIO:
 193     total_size += sizeof(XPVIO);
 194     carp("IO isn't complete");
 195     break;
 196   default:
 197     croak("Unknown variable type");
 198   }
 199   return total_size;
 200 }
 201
 202 MODULE = Devel::Size            PACKAGE = Devel::Size
 203
 204 PROTOTYPES: DISABLE
 205
 206 IV
 207 size(orig_thing)
 208      SV *orig_thing
 209 CODE:
 210 {
 211   SV *thing = orig_thing;
 212   /* Hash to track our seen pointers */
 213   HV *tracking_hash = newHV();
 214
 215   /* If they passed us a reference then dereference it. This is the
 216      only way we can check the sizes of arrays and hashes */
 217   if (SvOK(thing) && SvROK(thing)) {
 218     thing = SvRV(thing);
 219   }
 220
 221   RETVAL = thing_size(thing, tracking_hash);
 222   /* Clean up after ourselves */
 223   SvREFCNT_dec(tracking_hash);
 224 }
 225 OUTPUT:
 226   RETVAL
 227
 228
 229 IV
 230 total_size(orig_thing)
 231        SV *orig_thing
 232 CODE:
 233 {
 234   SV *thing = orig_thing;
 235   /* Hash to track our seen pointers */
 236   HV *tracking_hash = newHV();
 237   AV *pending_array = newAV();
 238
 239   /* Size starts at zero */
 240   RETVAL = 0;
 241
 242   /* If they passed us a reference then dereference it. This is the
 243      only way we can check the sizes of arrays and hashes */
 244   if (SvOK(thing) && SvROK(thing)) {
 245     thing = SvRV(thing);
 246   }
 247
 248   /* Put it on the pending array */
 249   av_push(pending_array, thing);
 250
 251   /* Now just yank things off the end of the array until it's done */
 252   while (av_len(pending_array) >= 0) {
 253     thing = av_pop(pending_array);
 254     /* Process it if we've not seen it */
 255     if (check_new(tracking_hash, thing)) {
 256       /* Is it valid? */
 257       if (thing) {
 258         /* Yes, it is. So let's check the type */
 259         switch (SvTYPE(thing)) {
 260         case SVt_RV:
 261           av_push(pending_array, SvRV(thing));
 262           break;
 263
 264         case SVt_PVAV:
 265           {
 266             /* Quick alias to cut down on casting */
 267             AV *tempAV = (AV *)thing;
 268             SV **tempSV;
 269
 270             /* Any elements? */
 271             if (av_len(tempAV) != -1) {
 272               IV index;
 273               /* Run through them all */
 274               for (index = 0; index <= av_len(tempAV); index++) {
 275                 /* Did we get something? */
 276                 if (tempSV = av_fetch(tempAV, index, 0)) {
 277                   /* Was it undef? */
 278                   if (*tempSV != &PL_sv_undef) {
 279                     /* Apparently not. Save it for later */
 280                     av_push(pending_array, *tempSV);
 281                   }
 282                 }
 283               }
 284             }
 285           }
 286           break;
 287
 288         case SVt_PVHV:
 289           /* Is there anything in here? */
 290           if (hv_iterinit((HV *)thing)) {
 291             HE *temp_he;
 292             while (temp_he = hv_iternext((HV *)thing)) {
 293               av_push(pending_array, hv_iterval((HV *)thing, temp_he));
 294             }
 295           }
 296           break;
 297
 298         case SVt_PVGV:
 299           /* Run through all the pieces and push the ones with bits */
 300           if (GvSV(thing)) {
 301             av_push(pending_array, (SV *)GvSV(thing));
 302           }
 303           if (GvFORM(thing)) {
 304             av_push(pending_array, (SV *)GvFORM(thing));
 305           }
 306           if (GvAV(thing)) {
 307             av_push(pending_array, (SV *)GvAV(thing));
 308           }
 309           if (GvHV(thing)) {
 310             av_push(pending_array, (SV *)GvHV(thing));
 311           }
 312           if (GvCV(thing)) {
 313             av_push(pending_array, (SV *)GvCV(thing));
 314           }
 315           break;
 316         default:
 317           break;
 318         }
 319       }
 320
 321       RETVAL += thing_size(thing, tracking_hash);
 322     }
 323   }
 324
 325   /* Clean up after ourselves */
 326   SvREFCNT_dec(tracking_hash);
 327   SvREFCNT_dec(pending_array);
 328 }
 329 OUTPUT:
 330   RETVAL
 331