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, 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 UV thing_size(SV *orig_thing, HV *tracking_hash) {
 357   SV *thing = orig_thing;
 358   UV total_size = sizeof(SV);
 359
 360   switch (SvTYPE(thing)) {
 361     /* Is it undef? */
 362   case SVt_NULL:
 363     break;
 364     /* Just a plain integer. This will be differently sized depending
 365        on whether purify's been compiled in */
 366   case SVt_IV:
 367 #ifdef PURIFY
 368     total_size += sizeof(sizeof(XPVIV));
 369 #else
 370     total_size += sizeof(IV);
 371 #endif
 372     break;
 373     /* Is it a float? Like the int, it depends on purify */
 374   case SVt_NV:
 375 #ifdef PURIFY
 376     total_size += sizeof(sizeof(XPVNV));
 377 #else
 378     total_size += sizeof(NV);
 379 #endif
 380     break;
 381     /* Is it a reference? */
 382   case SVt_RV:
 383     total_size += sizeof(XRV);
 384     break;
 385     /* How about a plain string? In which case we need to add in how
 386        much has been allocated */
 387   case SVt_PV:
 388     total_size += sizeof(XPV);
 389     total_size += SvLEN(thing);
 390     break;
 391     /* A string with an integer part? */
 392   case SVt_PVIV:
 393     total_size += sizeof(XPVIV);
 394     total_size += SvLEN(thing);
 395     break;
 396     /* A string with a float part? */
 397   case SVt_PVNV:
 398     total_size += sizeof(XPVNV);
 399     total_size += SvLEN(thing);
 400     break;
 401   case SVt_PVMG:
 402     total_size += sizeof(XPVMG);
 403     total_size += SvLEN(thing);
 404     total_size += magic_size(thing, tracking_hash);
 405     break;
 406   case SVt_PVBM:
 407     total_size += sizeof(XPVBM);
 408     total_size += SvLEN(thing);
 409     total_size += magic_size(thing, tracking_hash);
 410     break;
 411   case SVt_PVLV:
 412     total_size += sizeof(XPVLV);
 413     total_size += SvLEN(thing);
 414     total_size += magic_size(thing, tracking_hash);
 415     break;
 416     /* How much space is dedicated to the array? Not counting the
 417        elements in the array, mind, just the array itself */
 418   case SVt_PVAV:
 419     total_size += sizeof(XPVAV);
 420     /* Is there anything in the array? */
 421     if (AvMAX(thing) != -1) {
 422       total_size += sizeof(SV *) * AvMAX(thing);
 423     }
 424     /* Add in the bits on the other side of the beginning */
 425     total_size += (sizeof(SV *) * (AvARRAY(thing) - AvALLOC(thing)));
 426     /* Is there something hanging off the arylen element? */
 427     if (AvARYLEN(thing)) {
 428       if (check_new(tracking_hash, AvARYLEN(thing))) {
 429         total_size += thing_size(AvARYLEN(thing), tracking_hash);
 430       }
 431     }
 432     total_size += magic_size(thing, tracking_hash);
 433     break;
 434   case SVt_PVHV:
 435     /* First the base struct */
 436     total_size += sizeof(XPVHV);
 437     /* Now the array of buckets */
 438     total_size += (sizeof(HE *) * (HvMAX(thing) + 1));
 439     /* Now walk the bucket chain */
 440     if (HvARRAY(thing)) {
 441       HE *cur_entry;
 442       IV cur_bucket = 0;
 443       for (cur_bucket = 0; cur_bucket <= HvMAX(thing); cur_bucket++) {
 444         cur_entry = *(HvARRAY(thing) + cur_bucket);
 445         while (cur_entry) {
 446           total_size += sizeof(HE);
 447           if (cur_entry->hent_hek) {
 448             /* Hash keys can be shared. Have we seen this before? */
 449             if (check_new(tracking_hash, cur_entry->hent_hek)) {
 450               total_size += HEK_BASESIZE + cur_entry->hent_hek->hek_len + 2;
 451             }
 452           }
 453           cur_entry = cur_entry->hent_next;
 454         }
 455       }
 456     }
 457     total_size += magic_size(thing, tracking_hash);
 458     break;
 459   case SVt_PVCV:
 460     total_size += sizeof(XPVCV);
 461     total_size += magic_size(thing, tracking_hash);
 462
 463     total_size += ((XPVIO *) SvANY(thing))->xpv_len;
 464     if (check_new(tracking_hash, CvSTASH(thing))) {
 465       total_size += thing_size((SV *)CvSTASH(thing), tracking_hash);
 466     }
 467     if (check_new(tracking_hash, SvSTASH(thing))) {
 468       total_size += thing_size((SV *)SvSTASH(thing), tracking_hash);
 469     }
 470     if (check_new(tracking_hash, CvGV(thing))) {
 471       total_size += thing_size((SV *)CvGV(thing), tracking_hash);
 472     }
 473     if (check_new(tracking_hash, CvPADLIST(thing))) {
 474       total_size += thing_size((SV *)CvPADLIST(thing), tracking_hash);
 475     }
 476     if (check_new(tracking_hash, CvOUTSIDE(thing))) {
 477       total_size += thing_size((SV *)CvOUTSIDE(thing), tracking_hash);
 478     }
 479
 480     if (check_new(tracking_hash, CvSTART(thing))) {
 481       total_size += op_size(CvSTART(thing), tracking_hash);
 482     }
 483     if (check_new(tracking_hash, CvROOT(thing))) {
 484       total_size += op_size(CvROOT(thing), tracking_hash);
 485     }
 486
 487     break;
 488   case SVt_PVGV:
 489     total_size += magic_size(thing, tracking_hash);
 490     total_size += sizeof(XPVGV);
 491     total_size += GvNAMELEN(thing);
 492 #ifdef GvFILE
 493     /* Is there a file? */
 494     if (GvFILE(thing)) {
 495       if (check_new(tracking_hash, GvFILE(thing))) {
 496         total_size += strlen(GvFILE(thing));
 497       }
 498     }
 499 #endif
 500     /* Is there something hanging off the glob? */
 501     if (GvGP(thing)) {
 502       if (check_new(tracking_hash, GvGP(thing))) {
 503         total_size += sizeof(GP);
 504         {
 505           SV *generic_thing;
 506           if (generic_thing = (SV *)(GvGP(thing)->gp_sv)) {
 507             total_size += thing_size(generic_thing, tracking_hash);
 508           }
 509           if (generic_thing = (SV *)(GvGP(thing)->gp_form)) {
 510             total_size += thing_size(generic_thing, tracking_hash);
 511           }
 512           if (generic_thing = (SV *)(GvGP(thing)->gp_av)) {
 513             total_size += thing_size(generic_thing, tracking_hash);
 514           }
 515           if (generic_thing = (SV *)(GvGP(thing)->gp_hv)) {
 516             total_size += thing_size(generic_thing, tracking_hash);
 517           }
 518           if (generic_thing = (SV *)(GvGP(thing)->gp_egv)) {
 519             total_size += thing_size(generic_thing, tracking_hash);
 520           }
 521           if (generic_thing = (SV *)(GvGP(thing)->gp_cv)) {
 522             total_size += thing_size(generic_thing, tracking_hash);
 523           }
 524         }
 525       }
 526     }
 527     break;
 528   case SVt_PVFM:
 529     total_size += sizeof(XPVFM);
 530     total_size += magic_size(thing, tracking_hash);
 531     total_size += ((XPVIO *) SvANY(thing))->xpv_len;
 532     if (check_new(tracking_hash, CvPADLIST(thing))) {
 533       total_size += thing_size((SV *)CvPADLIST(thing), tracking_hash);
 534     }
 535     if (check_new(tracking_hash, CvOUTSIDE(thing))) {
 536       total_size += thing_size((SV *)CvOUTSIDE(thing), tracking_hash);
 537     }
 538
 539     if (go_yell && !fm_whine) {
 540       carp("Devel::Size: Calculated sizes for FMs are incomplete");
 541       fm_whine = 1;
 542     }
 543     break;
 544   case SVt_PVIO:
 545     total_size += sizeof(XPVIO);
 546     total_size += magic_size(thing, tracking_hash);
 547     if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xpv_pv)) {
 548       total_size += ((XPVIO *) SvANY(thing))->xpv_cur;
 549     }
 550     /* Some embedded char pointers */
 551     if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xio_top_name)) {
 552       total_size += strlen(((XPVIO *) SvANY(thing))->xio_top_name);
 553     }
 554     if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xio_fmt_name)) {
 555       total_size += strlen(((XPVIO *) SvANY(thing))->xio_fmt_name);
 556     }
 557     if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xio_bottom_name)) {
 558       total_size += strlen(((XPVIO *) SvANY(thing))->xio_bottom_name);
 559     }
 560     /* Throw the GVs on the list to be walked if they're not-null */
 561     if (((XPVIO *) SvANY(thing))->xio_top_gv) {
 562       total_size += thing_size((SV *)((XPVIO *) SvANY(thing))->xio_top_gv,
 563                                tracking_hash);
 564     }
 565     if (((XPVIO *) SvANY(thing))->xio_bottom_gv) {
 566       total_size += thing_size((SV *)((XPVIO *) SvANY(thing))->xio_bottom_gv,
 567                                tracking_hash);
 568     }
 569     if (((XPVIO *) SvANY(thing))->xio_fmt_gv) {
 570       total_size += thing_size((SV *)((XPVIO *) SvANY(thing))->xio_fmt_gv,
 571                                tracking_hash);
 572     }
 573
 574     /* Only go trotting through the IO structures if they're really
 575        trottable. If USE_PERLIO is defined we can do this. If
 576        not... we can't, so we don't even try */
 577 #ifdef USE_PERLIO
 578     /* Dig into xio_ifp and xio_ofp here */
 579     croak("Devel::Size: Can't size up perlio layers yet");
 580 #endif
 581     break;
 582   default:
 583     croak("Devel::Size: Unknown variable type");
 584   }
 585   return total_size;
 586 }
 587
 588 MODULE = Devel::Size            PACKAGE = Devel::Size
 589
 590 PROTOTYPES: DISABLE
 591
 592 IV
 593 size(orig_thing)
 594      SV *orig_thing
 595 CODE:
 596 {
 597   SV *thing = orig_thing;
 598   /* Hash to track our seen pointers */
 599   HV *tracking_hash = newHV();
 600   SV *warn_flag;
 601
 602   /* Check warning status */
 603   go_yell = 0;
 604   regex_whine = 0;
 605   fm_whine = 0;
 606
 607   if (NULL != (warn_flag = perl_get_sv("Devel::Size::warn", FALSE))) {
 608     go_yell = SvIV(warn_flag);
 609   }
 610
 611
 612   /* If they passed us a reference then dereference it. This is the
 613      only way we can check the sizes of arrays and hashes */
 614   if (SvOK(thing) && SvROK(thing)) {
 615     thing = SvRV(thing);
 616   }
 617
 618   RETVAL = thing_size(thing, tracking_hash);
 619   /* Clean up after ourselves */
 620   SvREFCNT_dec(tracking_hash);
 621 }
 622 OUTPUT:
 623   RETVAL
 624
 625
 626 IV
 627 total_size(orig_thing)
 628        SV *orig_thing
 629 CODE:
 630 {
 631   SV *thing = orig_thing;
 632   /* Hash to track our seen pointers */
 633   HV *tracking_hash = newHV();
 634   AV *pending_array = newAV();
 635   IV size = 0;
 636   SV *warn_flag;
 637
 638   IV count = 0;
 639
 640   /* Size starts at zero */
 641   RETVAL = 0;
 642
 643   /* Check warning status */
 644   go_yell = 0;
 645   regex_whine = 0;
 646   fm_whine = 0;
 647
 648   if (NULL != (warn_flag = perl_get_sv("Devel::Size::warn", FALSE))) {
 649     go_yell = SvIV(warn_flag);
 650   }
 651
 652
 653   /* If they passed us a reference then dereference it. This is the
 654      only way we can check the sizes of arrays and hashes */
 655   if (SvOK(thing) && SvROK(thing)) {
 656     thing = SvRV(thing);
 657   }
 658
 659   /* Put it on the pending array */
 660   av_push(pending_array, thing);
 661
 662   /* Now just yank things off the end of the array until it's done */
 663   while (av_len(pending_array) >= 0) {
 664     thing = av_pop(pending_array);
 665     /* Process it if we've not seen it */
 666     if (check_new(tracking_hash, thing)) {
 667       /* Is it valid? */
 668       if (thing) {
 669         /* Yes, it is. So let's check the type */
 670         switch (SvTYPE(thing)) {
 671         case SVt_RV:
 672           av_push(pending_array, SvRV(thing));
 673           break;
 674
 675         case SVt_PVAV:
 676           {
 677             /* Quick alias to cut down on casting */
 678             AV *tempAV = (AV *)thing;
 679             SV **tempSV;
 680
 681             /* Any elements? */
 682             if (av_len(tempAV) != -1) {
 683               IV index;
 684               /* Run through them all */
 685               for (index = 0; index <= av_len(tempAV); index++) {
 686                 /* Did we get something? */
 687                 if (tempSV = av_fetch(tempAV, index, 0)) {
 688                   /* Was it undef? */
 689                   if (*tempSV != &PL_sv_undef) {
 690                     /* Apparently not. Save it for later */
 691                     av_push(pending_array, *tempSV);
 692                   }
 693                 }
 694               }
 695             }
 696           }
 697           break;
 698
 699         case SVt_PVHV:
 700           /* Is there anything in here? */
 701           if (hv_iterinit((HV *)thing)) {
 702             HE *temp_he;
 703             while (temp_he = hv_iternext((HV *)thing)) {
 704               av_push(pending_array, hv_iterval((HV *)thing, temp_he));
 705             }
 706           }
 707           break;
 708
 709         case SVt_PVGV:
 710           /* Run through all the pieces and push the ones with bits */
 711           if (GvSV(thing)) {
 712             av_push(pending_array, (SV *)GvSV(thing));
 713           }
 714           if (GvFORM(thing)) {
 715             av_push(pending_array, (SV *)GvFORM(thing));
 716           }
 717           if (GvAV(thing)) {
 718             av_push(pending_array, (SV *)GvAV(thing));
 719           }
 720           if (GvHV(thing)) {
 721             av_push(pending_array, (SV *)GvHV(thing));
 722           }
 723           if (GvCV(thing)) {
 724             av_push(pending_array, (SV *)GvCV(thing));
 725           }
 726           break;
 727         default:
 728           break;
 729         }
 730       }
 731
 732
 733       size = thing_size(thing, tracking_hash);
 734       RETVAL += size;
 735     }
 736   }
 737
 738   /* Clean up after ourselves */
 739   SvREFCNT_dec(tracking_hash);
 740   SvREFCNT_dec(pending_array);
 741 }
 742 OUTPUT:
 743   RETVAL
 744