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 #if (PERL_VERSION < 11)
 202   /* Note the size of the paren offset thing */
 203   total_size += sizeof(I32) * baseregex->nparens * 2;
 204   total_size += strlen(baseregex->precomp);
 205 #else
 206   total_size += sizeof(struct regexp);
 207   total_size += sizeof(I32) * SvANY(baseregex)->nparens * 2;
 208   /*total_size += strlen(SvANY(baseregex)->subbeg);*/
 209 #endif
 210   if (go_yell && !regex_whine) {
 211     carp("Devel::Size: Calculated sizes for compiled regexes are incompatible, and probably always will be");
 212     regex_whine = 1;
 213   }
 214
 215   return total_size;
 216 }
 217
 218 UV op_size(OP *baseop, HV *tracking_hash) {
 219   UV total_size = 0;
 220
 221   if (check_new(tracking_hash, baseop->op_next)) {
 222     total_size += op_size(baseop->op_next, tracking_hash);
 223   }
 224
 225   switch (cc_opclass(baseop)) {
 226   case OPc_BASEOP:
 227     total_size += sizeof(struct op);
 228     break;
 229   case OPc_UNOP:
 230     total_size += sizeof(struct unop);
 231     if (check_new(tracking_hash, cUNOPx(baseop)->op_first)) {
 232       total_size += op_size(cUNOPx(baseop)->op_first, tracking_hash);
 233     }
 234     break;
 235   case OPc_BINOP:
 236     total_size += sizeof(struct binop);
 237     if (check_new(tracking_hash, cBINOPx(baseop)->op_first)) {
 238       total_size += op_size(cBINOPx(baseop)->op_first, tracking_hash);
 239     }
 240     if (check_new(tracking_hash, cBINOPx(baseop)->op_last)) {
 241       total_size += op_size(cBINOPx(baseop)->op_last, tracking_hash);
 242     }
 243     break;
 244   case OPc_LOGOP:
 245     total_size += sizeof(struct logop);
 246     if (check_new(tracking_hash, cLOGOPx(baseop)->op_first)) {
 247       total_size += op_size(cBINOPx(baseop)->op_first, tracking_hash);
 248     }
 249     if (check_new(tracking_hash, cLOGOPx(baseop)->op_other)) {
 250       total_size += op_size(cLOGOPx(baseop)->op_other, tracking_hash);
 251     }
 252     break;
 253   case OPc_LISTOP:
 254     total_size += sizeof(struct listop);
 255     if (check_new(tracking_hash, cLISTOPx(baseop)->op_first)) {
 256       total_size += op_size(cLISTOPx(baseop)->op_first, tracking_hash);
 257     }
 258     if (check_new(tracking_hash, cLISTOPx(baseop)->op_last)) {
 259       total_size += op_size(cLISTOPx(baseop)->op_last, tracking_hash);
 260     }
 261     break;
 262   case OPc_PMOP:
 263     total_size += sizeof(struct pmop);
 264     if (check_new(tracking_hash, cPMOPx(baseop)->op_first)) {
 265       total_size += op_size(cPMOPx(baseop)->op_first, tracking_hash);
 266     }
 267     if (check_new(tracking_hash, cPMOPx(baseop)->op_last)) {
 268       total_size += op_size(cPMOPx(baseop)->op_last, tracking_hash);
 269     }
 270 #if PERL_VERSION < 9 || (PERL_VERSION == 9 && PERL_SUBVERSION < 5)
 271     if (check_new(tracking_hash, cPMOPx(baseop)->op_pmreplroot)) {
 272       total_size += op_size(cPMOPx(baseop)->op_pmreplroot, tracking_hash);
 273     }
 274     if (check_new(tracking_hash, cPMOPx(baseop)->op_pmreplstart)) {
 275       total_size += op_size(cPMOPx(baseop)->op_pmreplstart, tracking_hash);
 276     }
 277     if (check_new(tracking_hash, cPMOPx(baseop)->op_pmnext)) {
 278       total_size += op_size((OP *)cPMOPx(baseop)->op_pmnext, tracking_hash);
 279     }
 280 #endif
 281     /* This is defined away in perl 5.8.x, but it is in there for
 282        5.6.x */
 283 #ifdef PM_GETRE
 284     if (check_new(tracking_hash, PM_GETRE((cPMOPx(baseop))))) {
 285       total_size += regex_size(PM_GETRE(cPMOPx(baseop)), tracking_hash);
 286     }
 287 #else
 288     if (check_new(tracking_hash, cPMOPx(baseop)->op_pmregexp)) {
 289       total_size += regex_size(cPMOPx(baseop)->op_pmregexp, tracking_hash);
 290     }
 291 #endif
 292     break;
 293   case OPc_SVOP:
 294     total_size += sizeof(struct pmop);
 295     if (check_new(tracking_hash, cSVOPx(baseop)->op_sv)) {
 296       total_size += thing_size(cSVOPx(baseop)->op_sv, tracking_hash);
 297     }
 298     break;
 299   case OPc_PADOP:
 300     total_size += sizeof(struct padop);
 301     break;
 302   case OPc_PVOP:
 303     if (check_new(tracking_hash, cPVOPx(baseop)->op_pv)) {
 304       total_size += strlen(cPVOPx(baseop)->op_pv);
 305     }
 306   case OPc_LOOP:
 307     total_size += sizeof(struct loop);
 308     if (check_new(tracking_hash, cLOOPx(baseop)->op_first)) {
 309       total_size += op_size(cLOOPx(baseop)->op_first, tracking_hash);
 310     }
 311     if (check_new(tracking_hash, cLOOPx(baseop)->op_last)) {
 312       total_size += op_size(cLOOPx(baseop)->op_last, tracking_hash);
 313     }
 314     if (check_new(tracking_hash, cLOOPx(baseop)->op_redoop)) {
 315       total_size += op_size(cLOOPx(baseop)->op_redoop, tracking_hash);
 316     }
 317     if (check_new(tracking_hash, cLOOPx(baseop)->op_nextop)) {
 318       total_size += op_size(cLOOPx(baseop)->op_nextop, tracking_hash);
 319     }
 320     /* Not working for some reason, but the code's here for later
 321        fixing
 322     if (check_new(tracking_hash, cLOOPx(baseop)->op_lastop)) {
 323       total_size += op_size(cLOOPx(baseop)->op_lastop, tracking_hash);
 324     }
 325     */
 326     break;
 327   case OPc_COP:
 328     {
 329       COP *basecop;
 330       basecop = (COP *)baseop;
 331       total_size += sizeof(struct cop);
 332
 333       if (check_new(tracking_hash, basecop->cop_label)) {
 334         total_size += strlen(basecop->cop_label);
 335       }
 336 #ifdef USE_ITHREADS
 337       if (check_new(tracking_hash, basecop->cop_file)) {
 338         total_size += strlen(basecop->cop_file);
 339       }
 340       if (check_new(tracking_hash, basecop->cop_stashpv)) {
 341         total_size += strlen(basecop->cop_stashpv);
 342       }
 343 #else
 344       if (check_new(tracking_hash, basecop->cop_stash)) {
 345         total_size += thing_size((SV *)basecop->cop_stash, tracking_hash);
 346       }
 347       if (check_new(tracking_hash, basecop->cop_filegv)) {
 348         total_size += thing_size((SV *)basecop->cop_filegv, tracking_hash);
 349       }
 350 #endif
 351
 352     }
 353     break;
 354   default:
 355     break;
 356   }
 357   return total_size;
 358 }
 359
 360 #if PERL_VERSION > 9 || (PERL_VERSION == 9 && PERL_SUBVERSION > 2)
 361 #  define NEW_HEAD_LAYOUT
 362 #endif
 363
 364 UV thing_size(SV *orig_thing, HV *tracking_hash) {
 365   SV *thing = orig_thing;
 366   UV total_size = sizeof(SV);
 367
 368   switch (SvTYPE(thing)) {
 369     /* Is it undef? */
 370   case SVt_NULL:
 371     break;
 372     /* Just a plain integer. This will be differently sized depending
 373        on whether purify's been compiled in */
 374   case SVt_IV:
 375 #ifndef NEW_HEAD_LAYOUT
 376 #  ifdef PURIFY
 377     total_size += sizeof(sizeof(XPVIV));
 378 #  else
 379     total_size += sizeof(IV);
 380 #  endif
 381 #endif
 382     break;
 383     /* Is it a float? Like the int, it depends on purify */
 384   case SVt_NV:
 385 #ifdef PURIFY
 386     total_size += sizeof(sizeof(XPVNV));
 387 #else
 388     total_size += sizeof(NV);
 389 #endif
 390     break;
 391 #if (PERL_VERSION < 11)
 392     /* Is it a reference? */
 393   case SVt_RV:
 394 #ifndef NEW_HEAD_LAYOUT
 395     total_size += sizeof(XRV);
 396 #endif
 397     break;
 398 #endif
 399     /* How about a plain string? In which case we need to add in how
 400        much has been allocated */
 401   case SVt_PV:
 402     total_size += sizeof(XPV);
 403     total_size += SvROK(thing) ? thing_size( SvRV(thing), tracking_hash) : SvLEN(thing);
 404     break;
 405     /* A string with an integer part? */
 406   case SVt_PVIV:
 407     total_size += sizeof(XPVIV);
 408     total_size += SvROK(thing) ? thing_size( SvRV(thing), tracking_hash) : SvLEN(thing);
 409     if(SvOOK(thing)) {
 410         total_size += SvIVX(thing);
 411         }
 412     break;
 413     /* A scalar/string/reference with a float part? */
 414   case SVt_PVNV:
 415     total_size += sizeof(XPVNV);
 416     total_size += SvROK(thing) ? thing_size( SvRV(thing), tracking_hash) : SvLEN(thing);
 417     break;
 418   case SVt_PVMG:
 419     total_size += sizeof(XPVMG);
 420     total_size += SvROK(thing) ? thing_size( SvRV(thing), tracking_hash) : SvLEN(thing);
 421     total_size += magic_size(thing, tracking_hash);
 422     break;
 423 #if PERL_VERSION <= 8
 424   case SVt_PVBM:
 425     total_size += sizeof(XPVBM);
 426     total_size += SvROK(thing) ? thing_size( SvRV(thing), tracking_hash) : SvLEN(thing);
 427     total_size += magic_size(thing, tracking_hash);
 428     break;
 429 #endif
 430   case SVt_PVLV:
 431     total_size += sizeof(XPVLV);
 432     total_size += SvROK(thing) ? thing_size( SvRV(thing), tracking_hash) : SvLEN(thing);
 433     total_size += magic_size(thing, tracking_hash);
 434     break;
 435     /* How much space is dedicated to the array? Not counting the
 436        elements in the array, mind, just the array itself */
 437   case SVt_PVAV:
 438     total_size += sizeof(XPVAV);
 439     /* Is there anything in the array? */
 440     if (AvMAX(thing) != -1) {
 441       /* an array with 10 slots has AvMax() set to 9 - te 2007-04-22 */
 442       total_size += sizeof(SV *) * (AvMAX(thing) + 1);
 443       /* printf ("total_size: %li AvMAX: %li av_len: %i\n", total_size, AvMAX(thing), av_len(thing)); */
 444     }
 445     /* Add in the bits on the other side of the beginning */
 446
 447       /* printf ("total_size %li, sizeof(SV *) %li, AvARRAY(thing) %li, AvALLOC(thing)%li , sizeof(ptr) %li \n",
 448         total_size, sizeof(SV*), AvARRAY(thing), AvALLOC(thing), sizeof( thing )); */
 449
 450     /* under Perl 5.8.8 64bit threading, AvARRAY(thing) was a pointer while AvALLOC was 0,
 451        resulting in grossly overstated sized for arrays. Technically, this shouldn't happen... */
 452     if (AvALLOC(thing) != 0) {
 453       total_size += (sizeof(SV *) * (AvARRAY(thing) - AvALLOC(thing)));
 454       }
 455     /* Is there something hanging off the arylen element? */
 456     if (AvARYLEN(thing)) {
 457       if (check_new(tracking_hash, AvARYLEN(thing))) {
 458         total_size += thing_size(AvARYLEN(thing), tracking_hash);
 459       }
 460     }
 461     total_size += magic_size(thing, tracking_hash);
 462     break;
 463   case SVt_PVHV:
 464     /* First the base struct */
 465     total_size += sizeof(XPVHV);
 466     /* Now the array of buckets */
 467     total_size += (sizeof(HE *) * (HvMAX(thing) + 1));
 468     /* Now walk the bucket chain */
 469     if (HvARRAY(thing)) {
 470       HE *cur_entry;
 471       IV cur_bucket = 0;
 472       for (cur_bucket = 0; cur_bucket <= HvMAX(thing); cur_bucket++) {
 473         cur_entry = *(HvARRAY(thing) + cur_bucket);
 474         while (cur_entry) {
 475           total_size += sizeof(HE);
 476           if (cur_entry->hent_hek) {
 477             /* Hash keys can be shared. Have we seen this before? */
 478             if (check_new(tracking_hash, cur_entry->hent_hek)) {
 479               total_size += HEK_BASESIZE + cur_entry->hent_hek->hek_len + 2;
 480             }
 481           }
 482           cur_entry = cur_entry->hent_next;
 483         }
 484       }
 485     }
 486     total_size += magic_size(thing, tracking_hash);
 487     break;
 488   case SVt_PVCV:
 489     total_size += sizeof(XPVCV);
 490     total_size += magic_size(thing, tracking_hash);
 491
 492     total_size += ((XPVIO *) SvANY(thing))->xpv_len;
 493     if (check_new(tracking_hash, CvSTASH(thing))) {
 494       total_size += thing_size((SV *)CvSTASH(thing), tracking_hash);
 495     }
 496     if (check_new(tracking_hash, SvSTASH(thing))) {
 497       total_size += thing_size((SV *)SvSTASH(thing), tracking_hash);
 498     }
 499     if (check_new(tracking_hash, CvGV(thing))) {
 500       total_size += thing_size((SV *)CvGV(thing), tracking_hash);
 501     }
 502     if (check_new(tracking_hash, CvPADLIST(thing))) {
 503       total_size += thing_size((SV *)CvPADLIST(thing), tracking_hash);
 504     }
 505     if (check_new(tracking_hash, CvOUTSIDE(thing))) {
 506       total_size += thing_size((SV *)CvOUTSIDE(thing), tracking_hash);
 507     }
 508
 509     if (check_new(tracking_hash, CvSTART(thing))) {
 510       total_size += op_size(CvSTART(thing), tracking_hash);
 511     }
 512     if (check_new(tracking_hash, CvROOT(thing))) {
 513       total_size += op_size(CvROOT(thing), tracking_hash);
 514     }
 515
 516     break;
 517   case SVt_PVGV:
 518     total_size += magic_size(thing, tracking_hash);
 519     total_size += sizeof(XPVGV);
 520     total_size += GvNAMELEN(thing);
 521 #ifdef GvFILE
 522     /* Is there a file? */
 523     if (GvFILE(thing)) {
 524       if (check_new(tracking_hash, GvFILE(thing))) {
 525         total_size += strlen(GvFILE(thing));
 526       }
 527     }
 528 #endif
 529     /* Is there something hanging off the glob? */
 530     if (GvGP(thing)) {
 531       if (check_new(tracking_hash, GvGP(thing))) {
 532         total_size += sizeof(GP);
 533         {
 534           SV *generic_thing;
 535           if ((generic_thing = (SV *)(GvGP(thing)->gp_sv))) {
 536             total_size += thing_size(generic_thing, tracking_hash);
 537           }
 538           if ((generic_thing = (SV *)(GvGP(thing)->gp_form))) {
 539             total_size += thing_size(generic_thing, tracking_hash);
 540           }
 541           if ((generic_thing = (SV *)(GvGP(thing)->gp_av))) {
 542             total_size += thing_size(generic_thing, tracking_hash);
 543           }
 544           if ((generic_thing = (SV *)(GvGP(thing)->gp_hv))) {
 545             total_size += thing_size(generic_thing, tracking_hash);
 546           }
 547           if ((generic_thing = (SV *)(GvGP(thing)->gp_egv))) {
 548             total_size += thing_size(generic_thing, tracking_hash);
 549           }
 550           if ((generic_thing = (SV *)(GvGP(thing)->gp_cv))) {
 551             total_size += thing_size(generic_thing, tracking_hash);
 552           }
 553         }
 554       }
 555     }
 556     break;
 557   case SVt_PVFM:
 558     total_size += sizeof(XPVFM);
 559     total_size += magic_size(thing, tracking_hash);
 560     total_size += ((XPVIO *) SvANY(thing))->xpv_len;
 561     if (check_new(tracking_hash, CvPADLIST(thing))) {
 562       total_size += thing_size((SV *)CvPADLIST(thing), tracking_hash);
 563     }
 564     if (check_new(tracking_hash, CvOUTSIDE(thing))) {
 565       total_size += thing_size((SV *)CvOUTSIDE(thing), tracking_hash);
 566     }
 567
 568     if (go_yell && !fm_whine) {
 569       carp("Devel::Size: Calculated sizes for FMs are incomplete");
 570       fm_whine = 1;
 571     }
 572     break;
 573   case SVt_PVIO:
 574     total_size += sizeof(XPVIO);
 575     total_size += magic_size(thing, tracking_hash);
 576     if (check_new(tracking_hash, (SvPVX(thing)))) {
 577       total_size += ((XPVIO *) SvANY(thing))->xpv_cur;
 578     }
 579     /* Some embedded char pointers */
 580     if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xio_top_name)) {
 581       total_size += strlen(((XPVIO *) SvANY(thing))->xio_top_name);
 582     }
 583     if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xio_fmt_name)) {
 584       total_size += strlen(((XPVIO *) SvANY(thing))->xio_fmt_name);
 585     }
 586     if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xio_bottom_name)) {
 587       total_size += strlen(((XPVIO *) SvANY(thing))->xio_bottom_name);
 588     }
 589     /* Throw the GVs on the list to be walked if they're not-null */
 590     if (((XPVIO *) SvANY(thing))->xio_top_gv) {
 591       total_size += thing_size((SV *)((XPVIO *) SvANY(thing))->xio_top_gv,
 592                                tracking_hash);
 593     }
 594     if (((XPVIO *) SvANY(thing))->xio_bottom_gv) {
 595       total_size += thing_size((SV *)((XPVIO *) SvANY(thing))->xio_bottom_gv,
 596                                tracking_hash);
 597     }
 598     if (((XPVIO *) SvANY(thing))->xio_fmt_gv) {
 599       total_size += thing_size((SV *)((XPVIO *) SvANY(thing))->xio_fmt_gv,
 600                                tracking_hash);
 601     }
 602
 603     /* Only go trotting through the IO structures if they're really
 604        trottable. If USE_PERLIO is defined we can do this. If
 605        not... we can't, so we don't even try */
 606 #ifdef USE_PERLIO
 607     /* Dig into xio_ifp and xio_ofp here */
 608     croak("Devel::Size: Can't size up perlio layers yet");
 609 #endif
 610     break;
 611   default:
 612     croak("Devel::Size: Unknown variable type");
 613   }
 614   return total_size;
 615 }
 616
 617 MODULE = Devel::Size            PACKAGE = Devel::Size
 618
 619 PROTOTYPES: DISABLE
 620
 621 IV
 622 size(orig_thing)
 623      SV *orig_thing
 624 CODE:
 625 {
 626   SV *thing = orig_thing;
 627   /* Hash to track our seen pointers */
 628   HV *tracking_hash = newHV();
 629   SV *warn_flag;
 630
 631   /* Check warning status */
 632   go_yell = 0;
 633   regex_whine = 0;
 634   fm_whine = 0;
 635
 636   if (NULL != (warn_flag = perl_get_sv("Devel::Size::warn", FALSE))) {
 637     go_yell = SvIV(warn_flag);
 638   }
 639
 640
 641   /* If they passed us a reference then dereference it. This is the
 642      only way we can check the sizes of arrays and hashes */
 643   if (SvOK(thing) && SvROK(thing)) {
 644     thing = SvRV(thing);
 645   }
 646
 647   RETVAL = thing_size(thing, tracking_hash);
 648   /* Clean up after ourselves */
 649   SvREFCNT_dec(tracking_hash);
 650 }
 651 OUTPUT:
 652   RETVAL
 653
 654
 655 IV
 656 total_size(orig_thing)
 657        SV *orig_thing
 658 CODE:
 659 {
 660   SV *thing = orig_thing;
 661   /* Hash to track our seen pointers */
 662   HV *tracking_hash = newHV();
 663   AV *pending_array = newAV();
 664   IV size = 0;
 665   SV *warn_flag;
 666
 667   /* Size starts at zero */
 668   RETVAL = 0;
 669
 670   /* Check warning status */
 671   go_yell = 0;
 672   regex_whine = 0;
 673   fm_whine = 0;
 674
 675   if (NULL != (warn_flag = perl_get_sv("Devel::Size::warn", FALSE))) {
 676     go_yell = SvIV(warn_flag);
 677   }
 678
 679
 680   /* If they passed us a reference then dereference it. This is the
 681      only way we can check the sizes of arrays and hashes */
 682   if (SvOK(thing) && SvROK(thing)) {
 683     thing = SvRV(thing);
 684   }
 685
 686   /* Put it on the pending array */
 687   av_push(pending_array, thing);
 688
 689   /* Now just yank things off the end of the array until it's done */
 690   while (av_len(pending_array) >= 0) {
 691     thing = av_pop(pending_array);
 692     /* Process it if we've not seen it */
 693     if (check_new(tracking_hash, thing)) {
 694       /* Is it valid? */
 695       if (thing) {
 696         /* printf ("Found type %i at %p\n", SvTYPE(thing), thing); */
 697
 698         /* Yes, it is. So let's check the type */
 699         switch (SvTYPE(thing)) {
 700         case SVt_RV:
 701           av_push(pending_array, SvRV(thing));
 702           break;
 703
 704         /* fix for bug #24846 (Does not correctly recurse into references in a PVNV-type scalar) */
 705         case SVt_PVNV:
 706           if (SvROK(thing))
 707             {
 708             av_push(pending_array, SvRV(thing));
 709             }
 710           break;
 711
 712         case SVt_PVAV:
 713           {
 714             /* Quick alias to cut down on casting */
 715             AV *tempAV = (AV *)thing;
 716             SV **tempSV;
 717
 718             /* Any elements? */
 719             if (av_len(tempAV) != -1) {
 720               IV index;
 721               /* Run through them all */
 722               for (index = 0; index <= av_len(tempAV); index++) {
 723                 /* Did we get something? */
 724                 if ((tempSV = av_fetch(tempAV, index, 0))) {
 725                   /* Was it undef? */
 726                   if (*tempSV != &PL_sv_undef) {
 727                     /* Apparently not. Save it for later */
 728                     av_push(pending_array, *tempSV);
 729                   }
 730                 }
 731               }
 732             }
 733           }
 734           break;
 735
 736         case SVt_PVHV:
 737           /* Is there anything in here? */
 738           if (hv_iterinit((HV *)thing)) {
 739             HE *temp_he;
 740             while ((temp_he = hv_iternext((HV *)thing))) {
 741               av_push(pending_array, hv_iterval((HV *)thing, temp_he));
 742             }
 743           }
 744           break;
 745
 746         case SVt_PVGV:
 747           /* Run through all the pieces and push the ones with bits */
 748           if (GvSV(thing)) {
 749             av_push(pending_array, (SV *)GvSV(thing));
 750           }
 751           if (GvFORM(thing)) {
 752             av_push(pending_array, (SV *)GvFORM(thing));
 753           }
 754           if (GvAV(thing)) {
 755             av_push(pending_array, (SV *)GvAV(thing));
 756           }
 757           if (GvHV(thing)) {
 758             av_push(pending_array, (SV *)GvHV(thing));
 759           }
 760           if (GvCV(thing)) {
 761             av_push(pending_array, (SV *)GvCV(thing));
 762           }
 763           break;
 764         default:
 765           break;
 766         }
 767       }
 768
 769
 770       size = thing_size(thing, tracking_hash);
 771       RETVAL += size;
 772     }
 773   }
 774
 775   /* Clean up after ourselves */
 776   SvREFCNT_dec(tracking_hash);
 777   SvREFCNT_dec(pending_array);
 778 }
 779 OUTPUT:
 780   RETVAL
 781