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_yes, 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("Devel::Size: Calculated sizes for CVs are incomplete");
 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 #ifdef GvFILE
 179     /* Is there a file? */
 180     if (GvFILE(thing)) {
 181       if (check_new(tracking_hash, GvFILE(thing))) {
 182         total_size += strlen(GvFILE(thing));
 183       }
 184     }
 185 #endif
 186     /* Is there something hanging off the glob? */
 187     if (GvGP(thing)) {
 188       if (check_new(tracking_hash, GvGP(thing))) {
 189         total_size += sizeof(GP);
 190         {
 191           SV *generic_thing;
 192           if (generic_thing = (SV *)(GvGP(thing)->gp_sv)) {
 193             total_size += thing_size(generic_thing, tracking_hash);
 194           }
 195           if (generic_thing = (SV *)(GvGP(thing)->gp_form)) {
 196             total_size += thing_size(generic_thing, tracking_hash);
 197           }
 198           if (generic_thing = (SV *)(GvGP(thing)->gp_av)) {
 199             total_size += thing_size(generic_thing, tracking_hash);
 200           }
 201           if (generic_thing = (SV *)(GvGP(thing)->gp_hv)) {
 202             total_size += thing_size(generic_thing, tracking_hash);
 203           }
 204           if (generic_thing = (SV *)(GvGP(thing)->gp_egv)) {
 205             total_size += thing_size(generic_thing, tracking_hash);
 206           }
 207           if (generic_thing = (SV *)(GvGP(thing)->gp_cv)) {
 208             total_size += thing_size(generic_thing, tracking_hash);
 209           }
 210         }
 211       }
 212     }
 213     break;
 214   case SVt_PVFM:
 215     total_size += sizeof(XPVFM);
 216     if (go_yell) {
 217       carp("Devel::Size: Calculated sizes for FMs are incomplete");
 218     }
 219     break;
 220   case SVt_PVIO:
 221     total_size += sizeof(XPVIO);
 222     total_size += magic_size(thing, tracking_hash);
 223     if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xpv_pv)) {
 224       total_size += ((XPVIO *) SvANY(thing))->xpv_cur;
 225     }
 226     /* Some embedded char pointers */
 227     if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xio_top_name)) {
 228       total_size += strlen(((XPVIO *) SvANY(thing))->xio_top_name);
 229     }
 230     if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xio_fmt_name)) {
 231       total_size += strlen(((XPVIO *) SvANY(thing))->xio_fmt_name);
 232     }
 233     if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xio_bottom_name)) {
 234       total_size += strlen(((XPVIO *) SvANY(thing))->xio_bottom_name);
 235     }
 236     /* Throw the GVs on the list to be walked if they're not-null */
 237     if (((XPVIO *) SvANY(thing))->xio_top_gv) {
 238       total_size += thing_size((SV *)((XPVIO *) SvANY(thing))->xio_top_gv,
 239                                tracking_hash);
 240     }
 241     if (((XPVIO *) SvANY(thing))->xio_bottom_gv) {
 242       total_size += thing_size((SV *)((XPVIO *) SvANY(thing))->xio_bottom_gv,
 243                                tracking_hash);
 244     }
 245     if (((XPVIO *) SvANY(thing))->xio_fmt_gv) {
 246       total_size += thing_size((SV *)((XPVIO *) SvANY(thing))->xio_fmt_gv,
 247                                tracking_hash);
 248     }
 249
 250     /* Only go trotting through the IO structures if they're really
 251        trottable. If USE_PERLIO is defined we can do this. If
 252        not... we can't, so we don't even try */
 253 #ifdef USE_PERLIO
 254     /* Dig into xio_ifp and xio_ofp here */
 255     croak("Devel::Size: Can't size up perlio layers yet");
 256 #endif
 257     break;
 258   default:
 259     croak("Devel::Size: Unknown variable type");
 260   }
 261   return total_size;
 262 }
 263
 264 MODULE = Devel::Size            PACKAGE = Devel::Size
 265
 266 PROTOTYPES: DISABLE
 267
 268 IV
 269 size(orig_thing)
 270      SV *orig_thing
 271 CODE:
 272 {
 273   SV *thing = orig_thing;
 274   /* Hash to track our seen pointers */
 275   HV *tracking_hash = newHV();
 276   SV *warn_flag;
 277
 278   /* Check warning status */
 279   go_yell = 0;
 280
 281   if (NULL != (warn_flag = perl_get_sv("Devel::Size::warn", FALSE))) {
 282     go_yell = SvIV(warn_flag);
 283   }
 284
 285
 286   /* If they passed us a reference then dereference it. This is the
 287      only way we can check the sizes of arrays and hashes */
 288   if (SvOK(thing) && SvROK(thing)) {
 289     thing = SvRV(thing);
 290   }
 291
 292   RETVAL = thing_size(thing, tracking_hash);
 293   /* Clean up after ourselves */
 294   SvREFCNT_dec(tracking_hash);
 295 }
 296 OUTPUT:
 297   RETVAL
 298
 299
 300 IV
 301 total_size(orig_thing)
 302        SV *orig_thing
 303 CODE:
 304 {
 305   SV *thing = orig_thing;
 306   /* Hash to track our seen pointers */
 307   HV *tracking_hash = newHV();
 308   AV *pending_array = newAV();
 309   IV size = 0;
 310   SV *warn_flag;
 311
 312   IV count = 0;
 313
 314   /* Size starts at zero */
 315   RETVAL = 0;
 316
 317   /* Check warning status */
 318   go_yell = 0;
 319
 320   if (NULL != (warn_flag = perl_get_sv("Devel::Size::warn", FALSE))) {
 321     go_yell = SvIV(warn_flag);
 322   }
 323
 324
 325   /* If they passed us a reference then dereference it. This is the
 326      only way we can check the sizes of arrays and hashes */
 327   if (SvOK(thing) && SvROK(thing)) {
 328     thing = SvRV(thing);
 329   }
 330
 331   /* Put it on the pending array */
 332   av_push(pending_array, thing);
 333
 334   /* Now just yank things off the end of the array until it's done */
 335   while (av_len(pending_array) >= 0) {
 336     thing = av_pop(pending_array);
 337     /* Process it if we've not seen it */
 338     if (check_new(tracking_hash, thing)) {
 339       /* Is it valid? */
 340       if (thing) {
 341         /* Yes, it is. So let's check the type */
 342         switch (SvTYPE(thing)) {
 343         case SVt_RV:
 344           av_push(pending_array, SvRV(thing));
 345           break;
 346
 347         case SVt_PVAV:
 348           {
 349             /* Quick alias to cut down on casting */
 350             AV *tempAV = (AV *)thing;
 351             SV **tempSV;
 352
 353             /* Any elements? */
 354             if (av_len(tempAV) != -1) {
 355               IV index;
 356               /* Run through them all */
 357               for (index = 0; index <= av_len(tempAV); index++) {
 358                 /* Did we get something? */
 359                 if (tempSV = av_fetch(tempAV, index, 0)) {
 360                   /* Was it undef? */
 361                   if (*tempSV != &PL_sv_undef) {
 362                     /* Apparently not. Save it for later */
 363                     av_push(pending_array, *tempSV);
 364                   }
 365                 }
 366               }
 367             }
 368           }
 369           break;
 370
 371         case SVt_PVHV:
 372           /* Is there anything in here? */
 373           if (hv_iterinit((HV *)thing)) {
 374             HE *temp_he;
 375             while (temp_he = hv_iternext((HV *)thing)) {
 376               av_push(pending_array, hv_iterval((HV *)thing, temp_he));
 377             }
 378           }
 379           break;
 380
 381         case SVt_PVGV:
 382           /* Run through all the pieces and push the ones with bits */
 383           if (GvSV(thing)) {
 384             av_push(pending_array, (SV *)GvSV(thing));
 385           }
 386           if (GvFORM(thing)) {
 387             av_push(pending_array, (SV *)GvFORM(thing));
 388           }
 389           if (GvAV(thing)) {
 390             av_push(pending_array, (SV *)GvAV(thing));
 391           }
 392           if (GvHV(thing)) {
 393             av_push(pending_array, (SV *)GvHV(thing));
 394           }
 395           if (GvCV(thing)) {
 396             av_push(pending_array, (SV *)GvCV(thing));
 397           }
 398           break;
 399         default:
 400           break;
 401         }
 402       }
 403
 404
 405       size = thing_size(thing, tracking_hash);
 406       RETVAL += size;
 407     }
 408   }
 409
 410   /* Clean up after ourselves */
 411   SvREFCNT_dec(tracking_hash);
 412   SvREFCNT_dec(pending_array);
 413 }
 414 OUTPUT:
 415   RETVAL
 416