Size.xs

   1 #include "EXTERN.h"
   2 #include "perl.h"
   3 #include "XSUB.h"
   4
   5 static int regex_whine;
   6 static int fm_whine;
   7
   8
   9 #define carp puts
  10 UV thing_size(SV *, HV *);
  11 typedef enum {
  12     OPc_NULL,   /* 0 */
  13     OPc_BASEOP, /* 1 */
  14     OPc_UNOP,   /* 2 */
  15     OPc_BINOP,  /* 3 */
  16     OPc_LOGOP,  /* 4 */
  17     OPc_LISTOP, /* 5 */
  18     OPc_PMOP,   /* 6 */
  19     OPc_SVOP,   /* 7 */
  20     OPc_PADOP,  /* 8 */
  21     OPc_PVOP,   /* 9 */
  22     OPc_LOOP,   /* 10 */
  23     OPc_COP     /* 11 */
  24 } opclass;
  25
  26 static opclass
  27 cc_opclass(OP *o)
  28 {
  29     if (!o)
  30         return OPc_NULL;
  31
  32     if (o->op_type == 0)
  33         return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
  34
  35     if (o->op_type == OP_SASSIGN)
  36         return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPc_UNOP : OPc_BINOP);
  37
  38 #ifdef USE_ITHREADS
  39     if (o->op_type == OP_GV || o->op_type == OP_GVSV || o->op_type == OP_AELEMFAST)
  40         return OPc_PADOP;
  41 #endif
  42
  43     if ((o->op_type = OP_TRANS)) {
  44       return OPc_BASEOP;
  45     }
  46
  47     switch (PL_opargs[o->op_type] & OA_CLASS_MASK) {
  48     case OA_BASEOP:
  49         return OPc_BASEOP;
  50
  51     case OA_UNOP:
  52         return OPc_UNOP;
  53
  54     case OA_BINOP:
  55         return OPc_BINOP;
  56
  57     case OA_LOGOP:
  58         return OPc_LOGOP;
  59
  60     case OA_LISTOP:
  61         return OPc_LISTOP;
  62
  63     case OA_PMOP:
  64         return OPc_PMOP;
  65
  66     case OA_SVOP:
  67         return OPc_SVOP;
  68
  69     case OA_PADOP:
  70         return OPc_PADOP;
  71
  72     case OA_PVOP_OR_SVOP:
  73         /*
  74          * Character translations (tr///) are usually a PVOP, keeping a
  75          * pointer to a table of shorts used to look up translations.
  76          * Under utf8, however, a simple table isn't practical; instead,
  77          * the OP is an SVOP, and the SV is a reference to a swash
  78          * (i.e., an RV pointing to an HV).
  79          */
  80         return (o->op_private & (OPpTRANS_TO_UTF|OPpTRANS_FROM_UTF))
  81                 ? OPc_SVOP : OPc_PVOP;
  82
  83     case OA_LOOP:
  84         return OPc_LOOP;
  85
  86     case OA_COP:
  87         return OPc_COP;
  88
  89     case OA_BASEOP_OR_UNOP:
  90         /*
  91          * UNI(OP_foo) in toke.c returns token UNI or FUNC1 depending on
  92          * whether parens were seen. perly.y uses OPf_SPECIAL to
  93          * signal whether a BASEOP had empty parens or none.
  94          * Some other UNOPs are created later, though, so the best
  95          * test is OPf_KIDS, which is set in newUNOP.
  96          */
  97         return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
  98
  99     case OA_FILESTATOP:
 100         /*
 101          * The file stat OPs are created via UNI(OP_foo) in toke.c but use
 102          * the OPf_REF flag to distinguish between OP types instead of the
 103          * usual OPf_SPECIAL flag. As usual, if OPf_KIDS is set, then we
 104          * return OPc_UNOP so that walkoptree can find our children. If
 105          * OPf_KIDS is not set then we check OPf_REF. Without OPf_REF set
 106          * (no argument to the operator) it's an OP; with OPf_REF set it's
 107          * an SVOP (and op_sv is the GV for the filehandle argument).
 108          */
 109         return ((o->op_flags & OPf_KIDS) ? OPc_UNOP :
 110 #ifdef USE_ITHREADS
 111                 (o->op_flags & OPf_REF) ? OPc_PADOP : OPc_BASEOP);
 112 #else
 113                 (o->op_flags & OPf_REF) ? OPc_SVOP : OPc_BASEOP);
 114 #endif
 115     case OA_LOOPEXOP:
 116         /*
 117          * next, last, redo, dump and goto use OPf_SPECIAL to indicate that a
 118          * label was omitted (in which case it's a BASEOP) or else a term was
 119          * seen. In this last case, all except goto are definitely PVOP but
 120          * goto is either a PVOP (with an ordinary constant label), an UNOP
 121          * with OPf_STACKED (with a non-constant non-sub) or an UNOP for
 122          * OP_REFGEN (with goto &sub) in which case OPf_STACKED also seems to
 123          * get set.
 124          */
 125         if (o->op_flags & OPf_STACKED)
 126             return OPc_UNOP;
 127         else if (o->op_flags & OPf_SPECIAL)
 128             return OPc_BASEOP;
 129         else
 130             return OPc_PVOP;
 131     }
 132     warn("can't determine class of operator %s, assuming BASEOP\n",
 133          PL_op_name[o->op_type]);
 134     return OPc_BASEOP;
 135 }
 136
 137
 138 #if !defined(NV)
 139 #define NV double
 140 #endif
 141
 142 static int go_yell = 1;
 143
 144 /* Checks to see if thing is in the hash. Returns true or false, and
 145    notes thing in the hash.
 146
 147    This code does one Evil Thing. Since we're tracking pointers, we
 148    tell perl that the string key is the address in the pointer. We do this by
 149    passing in the address of the address, along with the size of a
 150    pointer as the length. Perl then uses the four (or eight, on
 151    64-bit machines) bytes of the address as the string we're using as
 152    the key */
 153 IV check_new(HV *tracking_hash, const void *thing) {
 154   if (NULL == thing) {
 155     return FALSE;
 156   }
 157   if (hv_exists(tracking_hash, (char *)&thing, sizeof(void *))) {
 158     return FALSE;
 159   }
 160   hv_store(tracking_hash, (char *)&thing, sizeof(void *), &PL_sv_yes, 0);
 161   return TRUE;
 162
 163 }
 164
 165 /* Figure out how much magic is attached to the SV and return the
 166    size */
 167 IV magic_size(SV *thing, HV *tracking_hash) {
 168   IV total_size = 0;
 169   MAGIC *magic_pointer;
 170
 171   /* Is there any? */
 172   if (!SvMAGIC(thing)) {
 173     /* No, bail */
 174     return 0;
 175   }
 176
 177   /* Get the base magic pointer */
 178   magic_pointer = SvMAGIC(thing);
 179
 180   /* Have we seen the magic pointer? */
 181   while (magic_pointer && check_new(tracking_hash, magic_pointer)) {
 182     total_size += sizeof(MAGIC);
 183
 184     /* Have we seen the magic vtable? */
 185     if (magic_pointer->mg_virtual &&
 186         check_new(tracking_hash, magic_pointer->mg_virtual)) {
 187       total_size += sizeof(MGVTBL);
 188     }
 189
 190     /* Get the next in the chain */
 191     magic_pointer = magic_pointer->mg_moremagic;
 192   }
 193
 194   return total_size;
 195 }
 196
 197 UV regex_size(REGEXP *baseregex, HV *tracking_hash) {
 198   UV total_size = 0;
 199
 200   total_size += sizeof(REGEXP);
 201   /* Note hte size of the paren offset thing */
 202   total_size += sizeof(I32) * baseregex->nparens * 2;
 203   total_size += strlen(baseregex->precomp);
 204
 205   if (go_yell && !regex_whine) {
 206     carp("Devel::Size: Calculated sizes for compiled regexes are incomple, and probably always will be");
 207     regex_whine = 1;
 208   }
 209
 210   return total_size;
 211 }
 212
 213 UV op_size(OP *baseop, HV *tracking_hash) {
 214   UV total_size = 0;
 215
 216   if (check_new(tracking_hash, baseop->op_next)) {
 217     total_size += op_size(baseop->op_next, tracking_hash);
 218   }
 219   if (check_new(tracking_hash, baseop->op_next)) {
 220     total_size += op_size(baseop->op_next, tracking_hash);
 221   }
 222
 223   switch (cc_opclass(baseop)) {
 224   case OPc_BASEOP:
 225     total_size += sizeof(struct op);
 226     break;
 227   case OPc_UNOP:
 228     total_size += sizeof(struct unop);
 229     if (check_new(tracking_hash, cUNOPx(baseop)->op_first)) {
 230       total_size += op_size(cUNOPx(baseop)->op_first, tracking_hash);
 231     }
 232     break;
 233   case OPc_BINOP:
 234     total_size += sizeof(struct binop);
 235     if (check_new(tracking_hash, cBINOPx(baseop)->op_first)) {
 236       total_size += op_size(cBINOPx(baseop)->op_first, tracking_hash);
 237     }
 238     if (check_new(tracking_hash, cBINOPx(baseop)->op_last)) {
 239       total_size += op_size(cBINOPx(baseop)->op_last, tracking_hash);
 240     }
 241     break;
 242   case OPc_LOGOP:
 243     total_size += sizeof(struct logop);
 244     if (check_new(tracking_hash, cLOGOPx(baseop)->op_first)) {
 245       total_size += op_size(cBINOPx(baseop)->op_first, tracking_hash);
 246     }
 247     if (check_new(tracking_hash, cLOGOPx(baseop)->op_other)) {
 248       total_size += op_size(cLOGOPx(baseop)->op_other, tracking_hash);
 249     }
 250     break;
 251   case OPc_LISTOP:
 252     total_size += sizeof(struct listop);
 253     if (check_new(tracking_hash, cLISTOPx(baseop)->op_first)) {
 254       total_size += op_size(cLISTOPx(baseop)->op_first, tracking_hash);
 255     }
 256     if (check_new(tracking_hash, cLISTOPx(baseop)->op_last)) {
 257       total_size += op_size(cLISTOPx(baseop)->op_last, tracking_hash);
 258     }
 259     break;
 260   case OPc_PMOP:
 261     total_size += sizeof(struct pmop);
 262     if (check_new(tracking_hash, cPMOPx(baseop)->op_first)) {
 263       total_size += op_size(cPMOPx(baseop)->op_first, tracking_hash);
 264     }
 265     if (check_new(tracking_hash, cPMOPx(baseop)->op_last)) {
 266       total_size += op_size(cPMOPx(baseop)->op_last, tracking_hash);
 267     }
 268     if (check_new(tracking_hash, cPMOPx(baseop)->op_pmreplroot)) {
 269       total_size += op_size(cPMOPx(baseop)->op_pmreplroot, tracking_hash);
 270     }
 271     if (check_new(tracking_hash, cPMOPx(baseop)->op_pmreplstart)) {
 272       total_size += op_size(cPMOPx(baseop)->op_pmreplstart, tracking_hash);
 273     }
 274     if (check_new(tracking_hash, cPMOPx(baseop)->op_pmnext)) {
 275       total_size += op_size((OP *)cPMOPx(baseop)->op_pmnext, tracking_hash);
 276     }
 277     /* This is defined away in perl 5.8.x, but it is in there for
 278        5.6.x */
 279 #ifdef PM_GETRE
 280     if (check_new(tracking_hash, PM_GETRE((cPMOPx(baseop))))) {
 281       total_size += regex_size(PM_GETRE(cPMOPx(baseop)), tracking_hash);
 282     }
 283 #else
 284     if (check_new(tracking_hash, cPMOPx(baseop)->op_pmregexp)) {
 285       total_size += regex_size(cPMOPx(baseop)->op_pmregexp, tracking_hash);
 286     }
 287 #endif
 288     break;
 289   case OPc_SVOP:
 290     total_size += sizeof(struct pmop);
 291     if (check_new(tracking_hash, cSVOPx(baseop)->op_sv)) {
 292       total_size += thing_size(cSVOPx(baseop)->op_sv, tracking_hash);
 293     }
 294     break;
 295   case OPc_PADOP:
 296     total_size += sizeof(struct padop);
 297     break;
 298   case OPc_PVOP:
 299     if (check_new(tracking_hash, cPVOPx(baseop)->op_pv)) {
 300       total_size += strlen(cPVOPx(baseop)->op_pv);
 301     }
 302   case OPc_LOOP:
 303     total_size += sizeof(struct loop);
 304     if (check_new(tracking_hash, cLOOPx(baseop)->op_first)) {
 305       total_size += op_size(cLOOPx(baseop)->op_first, tracking_hash);
 306     }
 307     if (check_new(tracking_hash, cLOOPx(baseop)->op_last)) {
 308       total_size += op_size(cLOOPx(baseop)->op_last, tracking_hash);
 309     }
 310     if (check_new(tracking_hash, cLOOPx(baseop)->op_redoop)) {
 311       total_size += op_size(cLOOPx(baseop)->op_redoop, tracking_hash);
 312     }
 313     if (check_new(tracking_hash, cLOOPx(baseop)->op_nextop)) {
 314       total_size += op_size(cLOOPx(baseop)->op_nextop, tracking_hash);
 315     }
 316     /* Not working for some reason, but the code's here for later
 317        fixing
 318     if (check_new(tracking_hash, cLOOPx(baseop)->op_lastop)) {
 319       total_size += op_size(cLOOPx(baseop)->op_lastop, tracking_hash);
 320     }
 321     */
 322     break;
 323   case OPc_COP:
 324     {
 325       COP *basecop;
 326       basecop = (COP *)baseop;
 327       total_size += sizeof(struct cop);
 328
 329       if (check_new(tracking_hash, basecop->cop_label)) {
 330         total_size += strlen(basecop->cop_label);
 331       }
 332 #ifdef USE_ITHREADS
 333       if (check_new(tracking_hash, basecop->cop_file)) {
 334         total_size += strlen(basecop->cop_file);
 335       }
 336       if (check_new(tracking_hash, basecop->cop_stashpv)) {
 337         total_size += strlen(basecop->cop_stashpv);
 338       }
 339 #else
 340       if (check_new(tracking_hash, basecop->cop_stash)) {
 341         total_size += thing_size((SV *)basecop->cop_stash, tracking_hash);
 342       }
 343       if (check_new(tracking_hash, basecop->cop_filegv)) {
 344         total_size += thing_size((SV *)basecop->cop_filegv, tracking_hash);
 345       }
 346 #endif
 347
 348     }
 349     break;
 350   default:
 351     break;
 352   }
 353   return total_size;
 354 }
 355
 356 #if PERL_VERSION > 9 || (PERL_VERSION == 9 && PERL_SUBVERSION > 2)
 357 #  define NEW_HEAD_LAYOUT
 358 #endif
 359
 360 UV thing_size(SV *orig_thing, HV *tracking_hash) {
 361   SV *thing = orig_thing;
 362   UV total_size = sizeof(SV);
 363
 364   switch (SvTYPE(thing)) {
 365     /* Is it undef? */
 366   case SVt_NULL:
 367     break;
 368     /* Just a plain integer. This will be differently sized depending
 369        on whether purify's been compiled in */
 370   case SVt_IV:
 371 #ifndef NEW_HEAD_LAYOUT
 372 #  ifdef PURIFY
 373     total_size += sizeof(sizeof(XPVIV));
 374 #  else
 375     total_size += sizeof(IV);
 376 #  endif
 377 #endif
 378     break;
 379     /* Is it a float? Like the int, it depends on purify */
 380   case SVt_NV:
 381 #ifdef PURIFY
 382     total_size += sizeof(sizeof(XPVNV));
 383 #else
 384     total_size += sizeof(NV);
 385 #endif
 386     break;
 387     /* Is it a reference? */
 388   case SVt_RV:
 389 #ifndef NEW_HEAD_LAYOUT
 390     total_size += sizeof(XRV);
 391 #endif
 392     break;
 393     /* How about a plain string? In which case we need to add in how
 394        much has been allocated */
 395   case SVt_PV:
 396     total_size += sizeof(XPV);
 397     total_size += SvLEN(thing);
 398     break;
 399     /* A string with an integer part? */
 400   case SVt_PVIV:
 401     total_size += sizeof(XPVIV);
 402     total_size += SvLEN(thing);
 403     if(SvOOK(thing)) {
 404         total_size += SvIVX(thing);
 405         }
 406     break;
 407     /* A string with a float part? */
 408   case SVt_PVNV:
 409     total_size += sizeof(XPVNV);
 410     total_size += SvLEN(thing);
 411     break;
 412   case SVt_PVMG:
 413     total_size += sizeof(XPVMG);
 414     total_size += SvLEN(thing);
 415     total_size += magic_size(thing, tracking_hash);
 416     break;
 417 #if PERL_VERSION <= 8
 418   case SVt_PVBM:
 419     total_size += sizeof(XPVBM);
 420     total_size += SvLEN(thing);
 421     total_size += magic_size(thing, tracking_hash);
 422     break;
 423 #endif
 424   case SVt_PVLV:
 425     total_size += sizeof(XPVLV);
 426     total_size += SvLEN(thing);
 427     total_size += magic_size(thing, tracking_hash);
 428     break;
 429     /* How much space is dedicated to the array? Not counting the
 430        elements in the array, mind, just the array itself */
 431   case SVt_PVAV:
 432     total_size += sizeof(XPVAV);
 433     /* Is there anything in the array? */
 434     if (AvMAX(thing) != -1) {
 435       total_size += sizeof(SV *) * AvMAX(thing);
 436     }
 437     /* Add in the bits on the other side of the beginning */
 438
 439     /*
 440       printf ("total_size %li, sizeof(SV *) %li, AvARRAY(thing) %li, AvALLOC(thing)%li , sizeof(ptr) %li \n",
 441         total_size, sizeof(SV*), AvARRAY(thing), AvALLOC(thing), sizeof( thing )); */
 442
 443     /* under Perl 5.8.8 64bit threading, AvARRAY(thing) was a pointer while AvALLOC was 0,
 444        resulting in grossly overstated sized for arrays */
 445     if (AvALLOC(thing) != 0) {
 446       total_size += (sizeof(SV *) * (AvARRAY(thing) - AvALLOC(thing)));
 447       }
 448     /* Is there something hanging off the arylen element? */
 449     if (AvARYLEN(thing)) {
 450       if (check_new(tracking_hash, AvARYLEN(thing))) {
 451         total_size += thing_size(AvARYLEN(thing), tracking_hash);
 452       }
 453     }
 454     total_size += magic_size(thing, tracking_hash);
 455     break;
 456   case SVt_PVHV:
 457     /* First the base struct */
 458     total_size += sizeof(XPVHV);
 459     /* Now the array of buckets */
 460     total_size += (sizeof(HE *) * (HvMAX(thing) + 1));
 461     /* Now walk the bucket chain */
 462     if (HvARRAY(thing)) {
 463       HE *cur_entry;
 464       IV cur_bucket = 0;
 465       for (cur_bucket = 0; cur_bucket <= HvMAX(thing); cur_bucket++) {
 466         cur_entry = *(HvARRAY(thing) + cur_bucket);
 467         while (cur_entry) {
 468           total_size += sizeof(HE);
 469           if (cur_entry->hent_hek) {
 470             /* Hash keys can be shared. Have we seen this before? */
 471             if (check_new(tracking_hash, cur_entry->hent_hek)) {
 472               total_size += HEK_BASESIZE + cur_entry->hent_hek->hek_len + 2;
 473             }
 474           }
 475           cur_entry = cur_entry->hent_next;
 476         }
 477       }
 478     }
 479     total_size += magic_size(thing, tracking_hash);
 480     break;
 481   case SVt_PVCV:
 482     total_size += sizeof(XPVCV);
 483     total_size += magic_size(thing, tracking_hash);
 484
 485     total_size += ((XPVIO *) SvANY(thing))->xpv_len;
 486     if (check_new(tracking_hash, CvSTASH(thing))) {
 487       total_size += thing_size((SV *)CvSTASH(thing), tracking_hash);
 488     }
 489     if (check_new(tracking_hash, SvSTASH(thing))) {
 490       total_size += thing_size((SV *)SvSTASH(thing), tracking_hash);
 491     }
 492     if (check_new(tracking_hash, CvGV(thing))) {
 493       total_size += thing_size((SV *)CvGV(thing), tracking_hash);
 494     }
 495     if (check_new(tracking_hash, CvPADLIST(thing))) {
 496       total_size += thing_size((SV *)CvPADLIST(thing), tracking_hash);
 497     }
 498     if (check_new(tracking_hash, CvOUTSIDE(thing))) {
 499       total_size += thing_size((SV *)CvOUTSIDE(thing), tracking_hash);
 500     }
 501
 502     if (check_new(tracking_hash, CvSTART(thing))) {
 503       total_size += op_size(CvSTART(thing), tracking_hash);
 504     }
 505     if (check_new(tracking_hash, CvROOT(thing))) {
 506       total_size += op_size(CvROOT(thing), tracking_hash);
 507     }
 508
 509     break;
 510   case SVt_PVGV:
 511     total_size += magic_size(thing, tracking_hash);
 512     total_size += sizeof(XPVGV);
 513     total_size += GvNAMELEN(thing);
 514 #ifdef GvFILE
 515     /* Is there a file? */
 516     if (GvFILE(thing)) {
 517       if (check_new(tracking_hash, GvFILE(thing))) {
 518         total_size += strlen(GvFILE(thing));
 519       }
 520     }
 521 #endif
 522     /* Is there something hanging off the glob? */
 523     if (GvGP(thing)) {
 524       if (check_new(tracking_hash, GvGP(thing))) {
 525         total_size += sizeof(GP);
 526         {
 527           SV *generic_thing;
 528           if ((generic_thing = (SV *)(GvGP(thing)->gp_sv))) {
 529             total_size += thing_size(generic_thing, tracking_hash);
 530           }
 531           if ((generic_thing = (SV *)(GvGP(thing)->gp_form))) {
 532             total_size += thing_size(generic_thing, tracking_hash);
 533           }
 534           if ((generic_thing = (SV *)(GvGP(thing)->gp_av))) {
 535             total_size += thing_size(generic_thing, tracking_hash);
 536           }
 537           if ((generic_thing = (SV *)(GvGP(thing)->gp_hv))) {
 538             total_size += thing_size(generic_thing, tracking_hash);
 539           }
 540           if ((generic_thing = (SV *)(GvGP(thing)->gp_egv))) {
 541             total_size += thing_size(generic_thing, tracking_hash);
 542           }
 543           if ((generic_thing = (SV *)(GvGP(thing)->gp_cv))) {
 544             total_size += thing_size(generic_thing, tracking_hash);
 545           }
 546         }
 547       }
 548     }
 549     break;
 550   case SVt_PVFM:
 551     total_size += sizeof(XPVFM);
 552     total_size += magic_size(thing, tracking_hash);
 553     total_size += ((XPVIO *) SvANY(thing))->xpv_len;
 554     if (check_new(tracking_hash, CvPADLIST(thing))) {
 555       total_size += thing_size((SV *)CvPADLIST(thing), tracking_hash);
 556     }
 557     if (check_new(tracking_hash, CvOUTSIDE(thing))) {
 558       total_size += thing_size((SV *)CvOUTSIDE(thing), tracking_hash);
 559     }
 560
 561     if (go_yell && !fm_whine) {
 562       carp("Devel::Size: Calculated sizes for FMs are incomplete");
 563       fm_whine = 1;
 564     }
 565     break;
 566   case SVt_PVIO:
 567     total_size += sizeof(XPVIO);
 568     total_size += magic_size(thing, tracking_hash);
 569     if (check_new(tracking_hash, (SvPVX(thing)))) {
 570       total_size += ((XPVIO *) SvANY(thing))->xpv_cur;
 571     }
 572     /* Some embedded char pointers */
 573     if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xio_top_name)) {
 574       total_size += strlen(((XPVIO *) SvANY(thing))->xio_top_name);
 575     }
 576     if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xio_fmt_name)) {
 577       total_size += strlen(((XPVIO *) SvANY(thing))->xio_fmt_name);
 578     }
 579     if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xio_bottom_name)) {
 580       total_size += strlen(((XPVIO *) SvANY(thing))->xio_bottom_name);
 581     }
 582     /* Throw the GVs on the list to be walked if they're not-null */
 583     if (((XPVIO *) SvANY(thing))->xio_top_gv) {
 584       total_size += thing_size((SV *)((XPVIO *) SvANY(thing))->xio_top_gv,
 585                                tracking_hash);
 586     }
 587     if (((XPVIO *) SvANY(thing))->xio_bottom_gv) {
 588       total_size += thing_size((SV *)((XPVIO *) SvANY(thing))->xio_bottom_gv,
 589                                tracking_hash);
 590     }
 591     if (((XPVIO *) SvANY(thing))->xio_fmt_gv) {
 592       total_size += thing_size((SV *)((XPVIO *) SvANY(thing))->xio_fmt_gv,
 593                                tracking_hash);
 594     }
 595
 596     /* Only go trotting through the IO structures if they're really
 597        trottable. If USE_PERLIO is defined we can do this. If
 598        not... we can't, so we don't even try */
 599 #ifdef USE_PERLIO
 600     /* Dig into xio_ifp and xio_ofp here */
 601     croak("Devel::Size: Can't size up perlio layers yet");
 602 #endif
 603     break;
 604   default:
 605     croak("Devel::Size: Unknown variable type");
 606   }
 607   return total_size;
 608 }
 609
 610 MODULE = Devel::Size            PACKAGE = Devel::Size
 611
 612 PROTOTYPES: DISABLE
 613
 614 IV
 615 size(orig_thing)
 616      SV *orig_thing
 617 CODE:
 618 {
 619   SV *thing = orig_thing;
 620   /* Hash to track our seen pointers */
 621   HV *tracking_hash = newHV();
 622   SV *warn_flag;
 623
 624   /* Check warning status */
 625   go_yell = 0;
 626   regex_whine = 0;
 627   fm_whine = 0;
 628
 629   if (NULL != (warn_flag = perl_get_sv("Devel::Size::warn", FALSE))) {
 630     go_yell = SvIV(warn_flag);
 631   }
 632
 633
 634   /* If they passed us a reference then dereference it. This is the
 635      only way we can check the sizes of arrays and hashes */
 636   if (SvOK(thing) && SvROK(thing)) {
 637     thing = SvRV(thing);
 638   }
 639
 640   RETVAL = thing_size(thing, tracking_hash);
 641   /* Clean up after ourselves */
 642   SvREFCNT_dec(tracking_hash);
 643 }
 644 OUTPUT:
 645   RETVAL
 646
 647
 648 IV
 649 total_size(orig_thing)
 650        SV *orig_thing
 651 CODE:
 652 {
 653   SV *thing = orig_thing;
 654   /* Hash to track our seen pointers */
 655   HV *tracking_hash = newHV();
 656   AV *pending_array = newAV();
 657   IV size = 0;
 658   SV *warn_flag;
 659
 660   /* Size starts at zero */
 661   RETVAL = 0;
 662
 663   /* Check warning status */
 664   go_yell = 0;
 665   regex_whine = 0;
 666   fm_whine = 0;
 667
 668   if (NULL != (warn_flag = perl_get_sv("Devel::Size::warn", FALSE))) {
 669     go_yell = SvIV(warn_flag);
 670   }
 671
 672
 673   /* If they passed us a reference then dereference it. This is the
 674      only way we can check the sizes of arrays and hashes */
 675   if (SvOK(thing) && SvROK(thing)) {
 676     thing = SvRV(thing);
 677   }
 678
 679   /* Put it on the pending array */
 680   av_push(pending_array, thing);
 681
 682   /* Now just yank things off the end of the array until it's done */
 683   while (av_len(pending_array) >= 0) {
 684     thing = av_pop(pending_array);
 685     /* Process it if we've not seen it */
 686     if (check_new(tracking_hash, thing)) {
 687       /* Is it valid? */
 688       if (thing) {
 689         /* Yes, it is. So let's check the type */
 690         switch (SvTYPE(thing)) {
 691         case SVt_RV:
 692           av_push(pending_array, SvRV(thing));
 693           break;
 694
 695         case SVt_PVAV:
 696           {
 697             /* Quick alias to cut down on casting */
 698             AV *tempAV = (AV *)thing;
 699             SV **tempSV;
 700
 701             /* Any elements? */
 702             if (av_len(tempAV) != -1) {
 703               IV index;
 704               /* Run through them all */
 705               for (index = 0; index <= av_len(tempAV); index++) {
 706                 /* Did we get something? */
 707                 if ((tempSV = av_fetch(tempAV, index, 0))) {
 708                   /* Was it undef? */
 709                   if (*tempSV != &PL_sv_undef) {
 710                     /* Apparently not. Save it for later */
 711                     av_push(pending_array, *tempSV);
 712                   }
 713                 }
 714               }
 715             }
 716           }
 717           break;
 718
 719         case SVt_PVHV:
 720           /* Is there anything in here? */
 721           if (hv_iterinit((HV *)thing)) {
 722             HE *temp_he;
 723             while ((temp_he = hv_iternext((HV *)thing))) {
 724               av_push(pending_array, hv_iterval((HV *)thing, temp_he));
 725             }
 726           }
 727           break;
 728
 729         case SVt_PVGV:
 730           /* Run through all the pieces and push the ones with bits */
 731           if (GvSV(thing)) {
 732             av_push(pending_array, (SV *)GvSV(thing));
 733           }
 734           if (GvFORM(thing)) {
 735             av_push(pending_array, (SV *)GvFORM(thing));
 736           }
 737           if (GvAV(thing)) {
 738             av_push(pending_array, (SV *)GvAV(thing));
 739           }
 740           if (GvHV(thing)) {
 741             av_push(pending_array, (SV *)GvHV(thing));
 742           }
 743           if (GvCV(thing)) {
 744             av_push(pending_array, (SV *)GvCV(thing));
 745           }
 746           break;
 747         default:
 748           break;
 749         }
 750       }
 751
 752
 753       size = thing_size(thing, tracking_hash);
 754       RETVAL += size;
 755     }
 756   }
 757
 758   /* Clean up after ourselves */
 759   SvREFCNT_dec(tracking_hash);
 760   SvREFCNT_dec(pending_array);
 761 }
 762 OUTPUT:
 763   RETVAL
 764