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