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