Size.xs

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