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("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 #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     }
 192     break;
 193   case SVt_PVFM:
 194     total_size += sizeof(XPVFM);
 195     if (go_yell) {
 196       carp("FM isn't complete");
 197     }
 198     break;
 199   case SVt_PVIO:
 200     total_size += sizeof(XPVIO);
 201     if (go_yell) {
 202       carp("IO isn't complete");
 203     }
 204     break;
 205   default:
 206     croak("Unknown variable type");
 207   }
 208   return total_size;
 209 }
 210
 211 MODULE = Devel::Size            PACKAGE = Devel::Size
 212
 213 PROTOTYPES: DISABLE
 214
 215 IV
 216 size(orig_thing)
 217      SV *orig_thing
 218 CODE:
 219 {
 220   SV *thing = orig_thing;
 221   /* Hash to track our seen pointers */
 222   HV *tracking_hash = newHV();
 223   SV *warn_flag;
 224
 225   /* Check warning status */
 226   go_yell = 0;
 227
 228   if (NULL != (warn_flag = perl_get_sv("Devel::Size::warn", FALSE))) {
 229     go_yell = SvIV(warn_flag);
 230   }
 231
 232
 233   /* If they passed us a reference then dereference it. This is the
 234      only way we can check the sizes of arrays and hashes */
 235   if (SvOK(thing) && SvROK(thing)) {
 236     thing = SvRV(thing);
 237   }
 238
 239   RETVAL = thing_size(thing, tracking_hash);
 240   /* Clean up after ourselves */
 241   SvREFCNT_dec(tracking_hash);
 242 }
 243 OUTPUT:
 244   RETVAL
 245
 246
 247 IV
 248 total_size(orig_thing)
 249        SV *orig_thing
 250 CODE:
 251 {
 252   SV *thing = orig_thing;
 253   /* Hash to track our seen pointers */
 254   HV *tracking_hash = newHV();
 255   AV *pending_array = newAV();
 256   IV size = 0;
 257   SV *warn_flag;
 258
 259   IV count = 0;
 260
 261   /* Size starts at zero */
 262   RETVAL = 0;
 263
 264   /* Check warning status */
 265   go_yell = 0;
 266
 267   if (NULL != (warn_flag = perl_get_sv("Devel::Size::warn", FALSE))) {
 268     go_yell = SvIV(warn_flag);
 269   }
 270
 271
 272   /* If they passed us a reference then dereference it. This is the
 273      only way we can check the sizes of arrays and hashes */
 274   if (SvOK(thing) && SvROK(thing)) {
 275     thing = SvRV(thing);
 276   }
 277
 278   /* Put it on the pending array */
 279   av_push(pending_array, thing);
 280
 281   /* Now just yank things off the end of the array until it's done */
 282   while (av_len(pending_array) >= 0) {
 283     thing = av_pop(pending_array);
 284     /* Process it if we've not seen it */
 285     if (check_new(tracking_hash, thing)) {
 286       /* Is it valid? */
 287       if (thing) {
 288         /* Yes, it is. So let's check the type */
 289         switch (SvTYPE(thing)) {
 290         case SVt_RV:
 291           av_push(pending_array, SvRV(thing));
 292           break;
 293
 294         case SVt_PVAV:
 295           {
 296             /* Quick alias to cut down on casting */
 297             AV *tempAV = (AV *)thing;
 298             SV **tempSV;
 299
 300             /* Any elements? */
 301             if (av_len(tempAV) != -1) {
 302               IV index;
 303               /* Run through them all */
 304               for (index = 0; index <= av_len(tempAV); index++) {
 305                 /* Did we get something? */
 306                 if (tempSV = av_fetch(tempAV, index, 0)) {
 307                   /* Was it undef? */
 308                   if (*tempSV != &PL_sv_undef) {
 309                     /* Apparently not. Save it for later */
 310                     av_push(pending_array, *tempSV);
 311                   }
 312                 }
 313               }
 314             }
 315           }
 316           break;
 317
 318         case SVt_PVHV:
 319           /* Is there anything in here? */
 320           if (hv_iterinit((HV *)thing)) {
 321             HE *temp_he;
 322             while (temp_he = hv_iternext((HV *)thing)) {
 323               av_push(pending_array, hv_iterval((HV *)thing, temp_he));
 324             }
 325           }
 326           break;
 327
 328         case SVt_PVGV:
 329           /* Run through all the pieces and push the ones with bits */
 330           if (GvSV(thing)) {
 331             av_push(pending_array, (SV *)GvSV(thing));
 332           }
 333           if (GvFORM(thing)) {
 334             av_push(pending_array, (SV *)GvFORM(thing));
 335           }
 336           if (GvAV(thing)) {
 337             av_push(pending_array, (SV *)GvAV(thing));
 338           }
 339           if (GvHV(thing)) {
 340             av_push(pending_array, (SV *)GvHV(thing));
 341           }
 342           if (GvCV(thing)) {
 343             av_push(pending_array, (SV *)GvCV(thing));
 344           }
 345           break;
 346         default:
 347           break;
 348         }
 349       }
 350
 351
 352       size = thing_size(thing, tracking_hash);
 353       RETVAL += size;
 354     }
 355   }
 356
 357   /* Clean up after ourselves */
 358   SvREFCNT_dec(tracking_hash);
 359   SvREFCNT_dec(pending_array);
 360 }
 361 OUTPUT:
 362   RETVAL
 363