Size.xs

   1 /* -*- mode: C -*- */
   2
   3 #define PERL_NO_GET_CONTEXT
   4
   5 #include "EXTERN.h"
   6 #include "perl.h"
   7 #include "XSUB.h"
   8 #include "ppport.h"
   9
  10 #ifndef PERL_COMBI_VERSION
  11 #define PERL_COMBI_VERSION (PERL_REVISION * 1000000 + PERL_VERSION * 1000 + \
  12                                 PERL_SUBVERSION)
  13 #endif
  14
  15 /* Not yet in ppport.h */
  16 #ifndef CvISXSUB
  17 #  define CvISXSUB(cv)  (CvXSUB(cv) ? TRUE : FALSE)
  18 #endif
  19 #ifndef SvRV_const
  20 #  define SvRV_const(rv) SvRV(rv)
  21 #endif
  22 #ifndef SvOOK_offset
  23 #  define SvOOK_offset(sv, len) STMT_START { len = SvIVX(sv); } STMT_END
  24 #endif
  25 #ifndef SvIsCOW
  26 #  define SvIsCOW(sv)           ((SvFLAGS(sv) & (SVf_FAKE | SVf_READONLY)) == \
  27                                     (SVf_FAKE | SVf_READONLY))
  28 #endif
  29 #ifndef SvIsCOW_shared_hash
  30 #  define SvIsCOW_shared_hash(sv)   (SvIsCOW(sv) && SvLEN(sv) == 0)
  31 #endif
  32 #ifndef SvSHARED_HEK_FROM_PV
  33 #  define SvSHARED_HEK_FROM_PV(pvx) \
  34         ((struct hek*)(pvx - STRUCT_OFFSET(struct hek, hek_key)))
  35 #endif
  36
  37 #if PERL_VERSION < 6
  38 #  define PL_opargs opargs
  39 #  define PL_op_name op_name
  40 #endif
  41
  42 #ifdef _MSC_VER
  43 /* "structured exception" handling is a Microsoft extension to C and C++.
  44    It's *not* C++ exception handling - C++ exception handling can't capture
  45    SEGVs and suchlike, whereas this can. There's no known analagous
  46     functionality on other platforms.  */
  47 #  include <excpt.h>
  48 #  define TRY_TO_CATCH_SEGV __try
  49 #  define CAUGHT_EXCEPTION __except(EXCEPTION_EXECUTE_HANDLER)
  50 #else
  51 #  define TRY_TO_CATCH_SEGV if(1)
  52 #  define CAUGHT_EXCEPTION else
  53 #endif
  54
  55 #ifdef __GNUC__
  56 # define __attribute__(x)
  57 #endif
  58
  59 #if 0 && defined(DEBUGGING)
  60 #define dbg_printf(x) printf x
  61 #else
  62 #define dbg_printf(x)
  63 #endif
  64
  65 #define TAG /* printf( "# %s(%d)\n", __FILE__, __LINE__ ) */
  66 #define carp puts
  67
  68 /* The idea is to have a tree structure to store 1 bit per possible pointer
  69    address. The lowest 16 bits are stored in a block of 8092 bytes.
  70    The blocks are in a 256-way tree, indexed by the reset of the pointer.
  71    This can cope with 32 and 64 bit pointers, and any address space layout,
  72    without excessive memory needs. The assumption is that your CPU cache
  73    works :-) (And that we're not going to bust it)  */
  74
  75 #define BYTE_BITS    3
  76 #define LEAF_BITS   (16 - BYTE_BITS)
  77 #define LEAF_MASK   0x1FFF
  78
  79 struct state {
  80     UV total_size;
  81     bool regex_whine;
  82     bool fm_whine;
  83     bool dangle_whine;
  84     bool go_yell;
  85     /* My hunch (not measured) is that for most architectures pointers will
  86        start with 0 bits, hence the start of this array will be hot, and the
  87        end unused. So put the flags next to the hot end.  */
  88     void *tracking[256];
  89 };
  90
  91 /*
  92     Checks to see if thing is in the bitstring.
  93     Returns true or false, and
  94     notes thing in the segmented bitstring.
  95  */
  96 static bool
  97 check_new(struct state *st, const void *const p) {
  98     unsigned int bits = 8 * sizeof(void*);
  99     const size_t raw_p = PTR2nat(p);
 100     /* This effectively rotates the value right by the number of low always-0
 101        bits in an aligned pointer. The assmption is that most (if not all)
 102        pointers are aligned, and these will be in the same chain of nodes
 103        (and hence hot in the cache) but we can still deal with any unaligned
 104        pointers.  */
 105     const size_t cooked_p
 106         = (raw_p >> ALIGN_BITS) | (raw_p << (bits - ALIGN_BITS));
 107     const U8 this_bit = 1 << (cooked_p & 0x7);
 108     U8 **leaf_p;
 109     U8 *leaf;
 110     unsigned int i;
 111     void **tv_p = (void **) (st->tracking);
 112
 113     if (NULL == p) return FALSE;
 114     TRY_TO_CATCH_SEGV {
 115         const char c = *(const char *)p;
 116     }
 117     CAUGHT_EXCEPTION {
 118         if (st->dangle_whine)
 119             warn( "Devel::Size: Encountered invalid pointer: %p\n", p );
 120         return FALSE;
 121     }
 122     TAG;
 123
 124     bits -= 8;
 125     /* bits now 24 (32 bit pointers) or 56 (64 bit pointers) */
 126
 127     /* First level is always present.  */
 128     do {
 129         i = (unsigned int)((cooked_p >> bits) & 0xFF);
 130         if (!tv_p[i])
 131             Newxz(tv_p[i], 256, void *);
 132         tv_p = (void **)(tv_p[i]);
 133         bits -= 8;
 134     } while (bits > LEAF_BITS + BYTE_BITS);
 135     /* bits now 16 always */
 136 #if PERL_COMBI_VERSION > 5008008 || (!defined(MULTIPLICITY) && !defined(USE_THREADS))
 137     /* 5.8.8 and earlier have an assert() macro that uses Perl_croak, hence
 138        needs a my_perl under multiplicity. Similarly, under 5.005 threads
 139        Perl_croak needs a thr. In both cases, just skip the assert.  */
 140     assert(bits == 16);
 141 #endif
 142     leaf_p = (U8 **)tv_p;
 143     i = (unsigned int)((cooked_p >> bits) & 0xFF);
 144     if (!leaf_p[i])
 145         Newxz(leaf_p[i], 1 << LEAF_BITS, U8);
 146     leaf = leaf_p[i];
 147
 148     TAG;
 149
 150     i = (unsigned int)((cooked_p >> BYTE_BITS) & LEAF_MASK);
 151
 152     if(leaf[i] & this_bit)
 153         return FALSE;
 154
 155     leaf[i] |= this_bit;
 156     return TRUE;
 157 }
 158
 159 static void
 160 free_tracking_at(void **tv, int level)
 161 {
 162     int i = 255;
 163
 164     if (--level) {
 165         /* Nodes */
 166         do {
 167             if (tv[i]) {
 168                 free_tracking_at((void **) tv[i], level);
 169                 Safefree(tv[i]);
 170             }
 171         } while (i--);
 172     } else {
 173         /* Leaves */
 174         do {
 175             if (tv[i])
 176                 Safefree(tv[i]);
 177         } while (i--);
 178     }
 179 }
 180
 181 static void
 182 free_state(struct state *st)
 183 {
 184     const int top_level = (sizeof(void *) * 8 - LEAF_BITS - BYTE_BITS) / 8;
 185     free_tracking_at((void **)st->tracking, top_level);
 186     Safefree(st);
 187 }
 188
 189 /* For now, this is somewhat a compatibility bodge until the plan comes
 190    together for fine grained recursion control. total_size() would recurse into
 191    hash and array members, whereas sv_size() would not. However, sv_size() is
 192    called with CvSTASH() of a CV, which means that if it (also) starts to
 193    recurse fully, then the size of any CV now becomes the size of the entire
 194    symbol table reachable from it, and potentially the entire symbol table, if
 195    any subroutine makes a reference to a global (such as %SIG). The historical
 196    implementation of total_size() didn't report "everything", and changing the
 197    only available size to "everything" doesn't feel at all useful.  */
 198
 199 #define NO_RECURSION 0
 200 #define SOME_RECURSION 1
 201 #define TOTAL_SIZE_RECURSION 2
 202
 203 static void sv_size(pTHX_ struct state *, const SV *const, const int recurse);
 204
 205 typedef enum {
 206     OPc_NULL,   /* 0 */
 207     OPc_BASEOP, /* 1 */
 208     OPc_UNOP,   /* 2 */
 209     OPc_BINOP,  /* 3 */
 210     OPc_LOGOP,  /* 4 */
 211     OPc_LISTOP, /* 5 */
 212     OPc_PMOP,   /* 6 */
 213     OPc_SVOP,   /* 7 */
 214     OPc_PADOP,  /* 8 */
 215     OPc_PVOP,   /* 9 */
 216     OPc_LOOP,   /* 10 */
 217     OPc_COP /* 11 */
 218 #ifdef OA_CONDOP
 219     , OPc_CONDOP /* 12 */
 220 #endif
 221 #ifdef OA_GVOP
 222     , OPc_GVOP /* 13 */
 223 #endif
 224 #ifdef OA_METHOP
 225     , OPc_METHOP
 226 #endif
 227 #ifdef OA_UNOP_AUX
 228     , OPc_UNAUXOP
 229 #endif
 230
 231 } opclass;
 232
 233 static opclass
 234 cc_opclass(const OP * const o)
 235 {
 236     if (!o)
 237     return OPc_NULL;
 238     TRY_TO_CATCH_SEGV {
 239         if (o->op_type == 0)
 240         return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
 241
 242         if (o->op_type == OP_SASSIGN)
 243         return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPc_UNOP : OPc_BINOP);
 244
 245     #ifdef USE_ITHREADS
 246         if (o->op_type == OP_GV || o->op_type == OP_GVSV || o->op_type == OP_AELEMFAST)
 247         return OPc_PADOP;
 248     #endif
 249
 250         if ((o->op_type == OP_TRANS)) {
 251           return OPc_BASEOP;
 252         }
 253
 254         switch (PL_opargs[o->op_type] & OA_CLASS_MASK) {
 255         case OA_BASEOP: TAG;
 256         return OPc_BASEOP;
 257
 258         case OA_UNOP: TAG;
 259         return OPc_UNOP;
 260
 261         case OA_BINOP: TAG;
 262         return OPc_BINOP;
 263
 264         case OA_LOGOP: TAG;
 265         return OPc_LOGOP;
 266
 267         case OA_LISTOP: TAG;
 268         return OPc_LISTOP;
 269
 270         case OA_PMOP: TAG;
 271         return OPc_PMOP;
 272
 273         case OA_SVOP: TAG;
 274         return OPc_SVOP;
 275
 276 #ifdef OA_PADOP
 277         case OA_PADOP: TAG;
 278         return OPc_PADOP;
 279 #endif
 280
 281 #ifdef OA_GVOP
 282         case OA_GVOP: TAG;
 283         return OPc_GVOP;
 284 #endif
 285
 286 #ifdef OA_PVOP_OR_SVOP
 287         case OA_PVOP_OR_SVOP: TAG;
 288             /*
 289              * Character translations (tr///) are usually a PVOP, keeping a
 290              * pointer to a table of shorts used to look up translations.
 291              * Under utf8, however, a simple table isn't practical; instead,
 292              * the OP is an SVOP, and the SV is a reference to a swash
 293              * (i.e., an RV pointing to an HV).
 294              */
 295         return (o->op_private & (OPpTRANS_TO_UTF|OPpTRANS_FROM_UTF))
 296             ? OPc_SVOP : OPc_PVOP;
 297 #endif
 298
 299         case OA_LOOP: TAG;
 300         return OPc_LOOP;
 301
 302         case OA_COP: TAG;
 303         return OPc_COP;
 304
 305         case OA_BASEOP_OR_UNOP: TAG;
 306         /*
 307          * UNI(OP_foo) in toke.c returns token UNI or FUNC1 depending on
 308          * whether parens were seen. perly.y uses OPf_SPECIAL to
 309          * signal whether a BASEOP had empty parens or none.
 310          * Some other UNOPs are created later, though, so the best
 311          * test is OPf_KIDS, which is set in newUNOP.
 312          */
 313         return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
 314
 315         case OA_FILESTATOP: TAG;
 316         /*
 317          * The file stat OPs are created via UNI(OP_foo) in toke.c but use
 318          * the OPf_REF flag to distinguish between OP types instead of the
 319          * usual OPf_SPECIAL flag. As usual, if OPf_KIDS is set, then we
 320          * return OPc_UNOP so that walkoptree can find our children. If
 321          * OPf_KIDS is not set then we check OPf_REF. Without OPf_REF set
 322          * (no argument to the operator) it's an OP; with OPf_REF set it's
 323          * an SVOP (and op_sv is the GV for the filehandle argument).
 324          */
 325         return ((o->op_flags & OPf_KIDS) ? OPc_UNOP :
 326     #ifdef USE_ITHREADS
 327             (o->op_flags & OPf_REF) ? OPc_PADOP : OPc_BASEOP);
 328     #else
 329             (o->op_flags & OPf_REF) ? OPc_SVOP : OPc_BASEOP);
 330     #endif
 331         case OA_LOOPEXOP: TAG;
 332         /*
 333          * next, last, redo, dump and goto use OPf_SPECIAL to indicate that a
 334          * label was omitted (in which case it's a BASEOP) or else a term was
 335          * seen. In this last case, all except goto are definitely PVOP but
 336          * goto is either a PVOP (with an ordinary constant label), an UNOP
 337          * with OPf_STACKED (with a non-constant non-sub) or an UNOP for
 338          * OP_REFGEN (with goto &sub) in which case OPf_STACKED also seems to
 339          * get set.
 340          */
 341         if (o->op_flags & OPf_STACKED)
 342             return OPc_UNOP;
 343         else if (o->op_flags & OPf_SPECIAL)
 344             return OPc_BASEOP;
 345         else
 346             return OPc_PVOP;
 347
 348 #ifdef OA_CONDOP
 349         case OA_CONDOP: TAG;
 350             return OPc_CONDOP;
 351 #endif
 352
 353 #ifdef OA_METHOP
 354         case OA_METHOP: TAG;
 355             return OPc_METHOP;
 356 #endif
 357 #ifdef OA_UNOP_AUX
 358         case OA_UNOP_AUX: TAG;
 359             return OPc_UNAUXOP;
 360 #endif
 361         }
 362         warn("Devel::Size: Can't determine class of operator %s, assuming BASEOP\n",
 363          PL_op_name[o->op_type]);
 364     }
 365     CAUGHT_EXCEPTION { }
 366     return OPc_BASEOP;
 367 }
 368
 369 /* Figure out how much magic is attached to the SV and return the
 370    size */
 371 static void
 372 magic_size(pTHX_ const SV * const thing, struct state *st) {
 373   MAGIC *magic_pointer = SvMAGIC(thing);
 374
 375   /* Have we seen the magic pointer?  (NULL has always been seen before)  */
 376   while (check_new(st, magic_pointer)) {
 377     st->total_size += sizeof(MAGIC);
 378     /* magic vtables aren't freed when magic is freed, so don't count them.
 379        (They are static structures. Anything that assumes otherwise is buggy.)
 380     */
 381
 382
 383     TRY_TO_CATCH_SEGV {
 384         sv_size(aTHX_ st, magic_pointer->mg_obj, TOTAL_SIZE_RECURSION);
 385         if (magic_pointer->mg_len == HEf_SVKEY) {
 386             sv_size(aTHX_ st, (SV *)magic_pointer->mg_ptr, TOTAL_SIZE_RECURSION);
 387         }
 388 #if defined(PERL_MAGIC_utf8) && defined (PERL_MAGIC_UTF8_CACHESIZE)
 389         else if (magic_pointer->mg_type == PERL_MAGIC_utf8) {
 390             if (check_new(st, magic_pointer->mg_ptr)) {
 391                 st->total_size += PERL_MAGIC_UTF8_CACHESIZE * 2 * sizeof(STRLEN);
 392             }
 393         }
 394 #endif
 395         else if (magic_pointer->mg_len > 0) {
 396             if (check_new(st, magic_pointer->mg_ptr)) {
 397                 st->total_size += magic_pointer->mg_len;
 398             }
 399         }
 400
 401         /* Get the next in the chain */
 402         magic_pointer = magic_pointer->mg_moremagic;
 403     }
 404     CAUGHT_EXCEPTION {
 405         if (st->dangle_whine)
 406             warn( "Devel::Size: Encountered bad magic at: %p\n", magic_pointer );
 407     }
 408   }
 409 }
 410
 411 static void
 412 check_new_and_strlen(struct state *st, const char *const p) {
 413     if(check_new(st, p))
 414         st->total_size += 1 + strlen(p);
 415 }
 416
 417 static void
 418 regex_size(const REGEXP * const baseregex, struct state *st) {
 419     if(!check_new(st, baseregex))
 420         return;
 421   st->total_size += sizeof(REGEXP);
 422 #if (PERL_VERSION < 11)
 423   /* Note the size of the paren offset thing */
 424   st->total_size += sizeof(I32) * baseregex->nparens * 2;
 425   st->total_size += strlen(baseregex->precomp);
 426 #else
 427   st->total_size += sizeof(struct regexp);
 428   st->total_size += sizeof(I32) * SvANY(baseregex)->nparens * 2;
 429   /*st->total_size += strlen(SvANY(baseregex)->subbeg);*/
 430 #endif
 431   if (st->go_yell && !st->regex_whine) {
 432     carp("Devel::Size: Calculated sizes for compiled regexes are incompatible, and probably always will be");
 433     st->regex_whine = 1;
 434   }
 435 }
 436
 437 static void
 438 op_size(pTHX_ const OP * const baseop, struct state *st)
 439 {
 440     TRY_TO_CATCH_SEGV {
 441         TAG;
 442         if(!check_new(st, baseop))
 443             return;
 444         TAG;
 445         op_size(aTHX_ baseop->op_next, st);
 446         TAG;
 447         switch (cc_opclass(baseop)) {
 448         case OPc_BASEOP: TAG;
 449             st->total_size += sizeof(struct op);
 450             TAG;break;
 451         case OPc_UNOP: TAG;
 452             st->total_size += sizeof(struct unop);
 453             op_size(aTHX_ ((UNOP *)baseop)->op_first, st);
 454             TAG;break;
 455         case OPc_BINOP: TAG;
 456             st->total_size += sizeof(struct binop);
 457             op_size(aTHX_ ((BINOP *)baseop)->op_first, st);
 458             op_size(aTHX_ ((BINOP *)baseop)->op_last, st);
 459             TAG;break;
 460         case OPc_LOGOP: TAG;
 461             st->total_size += sizeof(struct logop);
 462             op_size(aTHX_ ((BINOP *)baseop)->op_first, st);
 463             op_size(aTHX_ ((LOGOP *)baseop)->op_other, st);
 464             TAG;break;
 465 #ifdef OA_CONDOP
 466         case OPc_CONDOP: TAG;
 467             st->total_size += sizeof(struct condop);
 468             op_size(aTHX_ ((BINOP *)baseop)->op_first, st);
 469             op_size(aTHX_ ((CONDOP *)baseop)->op_true, st);
 470             op_size(aTHX_ ((CONDOP *)baseop)->op_false, st);
 471             TAG;break;
 472 #endif
 473         case OPc_LISTOP: TAG;
 474             st->total_size += sizeof(struct listop);
 475             op_size(aTHX_ ((LISTOP *)baseop)->op_first, st);
 476             op_size(aTHX_ ((LISTOP *)baseop)->op_last, st);
 477             TAG;break;
 478         case OPc_PMOP: TAG;
 479             st->total_size += sizeof(struct pmop);
 480             op_size(aTHX_ ((PMOP *)baseop)->op_first, st);
 481             op_size(aTHX_ ((PMOP *)baseop)->op_last, st);
 482 #if PERL_VERSION < 9 || (PERL_VERSION == 9 && PERL_SUBVERSION < 5)
 483             op_size(aTHX_ ((PMOP *)baseop)->op_pmreplroot, st);
 484             op_size(aTHX_ ((PMOP *)baseop)->op_pmreplstart, st);
 485 #endif
 486             /* This is defined away in perl 5.8.x, but it is in there for
 487                5.6.x */
 488 #ifdef PM_GETRE
 489             regex_size(PM_GETRE((PMOP *)baseop), st);
 490 #else
 491             regex_size(((PMOP *)baseop)->op_pmregexp, st);
 492 #endif
 493             TAG;break;
 494         case OPc_SVOP: TAG;
 495             st->total_size += sizeof(struct pmop);
 496             if (!(baseop->op_type == OP_AELEMFAST
 497                   && baseop->op_flags & OPf_SPECIAL)) {
 498                 /* not an OP_PADAV replacement */
 499                 sv_size(aTHX_ st, ((SVOP *)baseop)->op_sv, SOME_RECURSION);
 500             }
 501             TAG;break;
 502 #ifdef OA_PADOP
 503       case OPc_PADOP: TAG;
 504           st->total_size += sizeof(struct padop);
 505           TAG;break;
 506 #endif
 507 #ifdef OA_GVOP
 508       case OPc_GVOP: TAG;
 509           st->total_size += sizeof(struct gvop);
 510           sv_size(aTHX_ st, ((GVOP *)baseop)->op_gv, SOME_RECURSION);
 511           TAG;break;
 512 #endif
 513         case OPc_PVOP: TAG;
 514             check_new_and_strlen(st, ((PVOP *)baseop)->op_pv);
 515             TAG;break;
 516         case OPc_LOOP: TAG;
 517             st->total_size += sizeof(struct loop);
 518             op_size(aTHX_ ((LOOP *)baseop)->op_first, st);
 519             op_size(aTHX_ ((LOOP *)baseop)->op_last, st);
 520             op_size(aTHX_ ((LOOP *)baseop)->op_redoop, st);
 521             op_size(aTHX_ ((LOOP *)baseop)->op_nextop, st);
 522             op_size(aTHX_ ((LOOP *)baseop)->op_lastop, st);
 523             TAG;break;
 524         case OPc_COP: TAG;
 525         {
 526           COP *basecop;
 527           basecop = (COP *)baseop;
 528           st->total_size += sizeof(struct cop);
 529
 530           /* Change 33656 by nicholas@mouse-mill on 2008/04/07 11:29:51
 531           Eliminate cop_label from struct cop by storing a label as the first
 532           entry in the hints hash. Most statements don't have labels, so this
 533           will save memory. Not sure how much.
 534           The check below will be incorrect fail on bleadperls
 535           before 5.11 @33656, but later than 5.10, producing slightly too
 536           small memory sizes on these Perls. */
 537 #if (PERL_VERSION < 11)
 538           check_new_and_strlen(st, basecop->cop_label);
 539 #endif
 540 #ifdef USE_ITHREADS
 541           check_new_and_strlen(st, basecop->cop_file);
 542 #if PERL_VERSION < 17 || (PERL_VERSION == 17 && PERL_SUBVERSION == 0)
 543           /* This pointer is owned by the COP, and freed with it.  */
 544           check_new_and_strlen(st, basecop->cop_stashpv);
 545 #else
 546           /* A per-interpreter pointer for this stash is allocated in
 547              PL_stashpad. */
 548           if (check_new(st, PL_stashpad + basecop->cop_stashoff))
 549               st->total_size += sizeof(PL_stashpad[basecop->cop_stashoff]);
 550 #endif
 551 #else
 552           sv_size(aTHX_ st, (SV *)basecop->cop_filegv, SOME_RECURSION);
 553 #endif
 554
 555         }
 556         TAG;break;
 557 #ifdef OA_METHOP
 558         case OPc_METHOP: TAG;
 559             st->total_size += sizeof(struct methop);
 560             if (baseop->op_type == OP_METHOD)
 561                 op_size(aTHX_ ((UNOP *)baseop)->op_first, st);
 562             else
 563                 sv_size(aTHX_ st, cMETHOPx_meth(baseop), SOME_RECURSION);
 564 #if PERL_VERSION*1000+PERL_SUBVERSION >= 21007
 565             if (baseop->op_type == OP_METHOD_REDIR || baseop->op_type == OP_METHOD_REDIR_SUPER) {
 566                 SV *rclass = cMETHOPx_rclass(baseop);
 567                 if(SvTYPE(rclass) != SVt_PVHV)
 568                     sv_size(aTHX_ st, rclass, SOME_RECURSION);
 569             }
 570 #endif
 571             TAG;break;
 572 #endif
 573 #ifdef OA_UNOP_AUX
 574         case OPc_UNAUXOP: TAG;
 575             st->total_size += sizeof(struct unop_aux) + sizeof(UNOP_AUX_item) * (cUNOP_AUXx(baseop)->op_aux[-1].uv+1);
 576             op_size(aTHX_ ((UNOP *)baseop)->op_first, st);
 577             if (baseop->op_type == OP_MULTIDEREF) {
 578                 UNOP_AUX_item *items = cUNOP_AUXx(baseop)->op_aux;
 579                 UV actions = items->uv;
 580                 bool last = 0;
 581                 bool is_hash = 0;
 582                 while (!last) {
 583                     switch (actions & MDEREF_ACTION_MASK) {
 584                         case MDEREF_reload:
 585                             actions = (++items)->uv;
 586                             continue;
 587                         case MDEREF_HV_padhv_helem:
 588                         case MDEREF_HV_gvhv_helem:
 589                         case MDEREF_HV_gvsv_vivify_rv2hv_helem:
 590                         case MDEREF_HV_padsv_vivify_rv2hv_helem:
 591                             is_hash = 1;
 592                         case MDEREF_AV_padav_aelem:
 593                         case MDEREF_AV_gvav_aelem:
 594                         case MDEREF_AV_gvsv_vivify_rv2av_aelem:
 595                         case MDEREF_AV_padsv_vivify_rv2av_aelem:
 596                             ++items;
 597                             goto do_elem;
 598                         case MDEREF_HV_pop_rv2hv_helem:
 599                         case MDEREF_HV_vivify_rv2hv_helem:
 600                             is_hash = 1;
 601                         case MDEREF_AV_pop_rv2av_aelem:
 602                         case MDEREF_AV_vivify_rv2av_aelem:
 603                         do_elem:
 604                             switch (actions & MDEREF_INDEX_MASK) {
 605                                 case MDEREF_INDEX_none:
 606                                     last = 1;
 607                                     break;
 608                                 case MDEREF_INDEX_const:
 609                                     ++items;
 610                                     if (is_hash) {
 611 #ifdef USE_ITHREADS
 612                                         SV *key = PAD_SVl(items->pad_offset);
 613 #else
 614                                         SV *key = items->sv;
 615 #endif
 616                                         sv_size(aTHX_ st, key, SOME_RECURSION);
 617                                     }
 618                                     break;
 619                                 case MDEREF_INDEX_padsv:
 620                                 case MDEREF_INDEX_gvsv:
 621                                     ++items;
 622                                     break;
 623                             }
 624                             if (actions & MDEREF_FLAG_last)
 625                                 last = 1;
 626                             is_hash = 0;
 627                             break;
 628                         default:
 629                             last = 1;
 630                             break;
 631                     }
 632                     actions >>= MDEREF_SHIFT;
 633                 }
 634             }
 635             TAG;break;
 636 #endif
 637       default:
 638         TAG;break;
 639       }
 640   }
 641   CAUGHT_EXCEPTION {
 642       if (st->dangle_whine)
 643           warn( "Devel::Size: Encountered dangling pointer in opcode at: %p\n", baseop );
 644   }
 645 }
 646
 647 static void
 648 hek_size(pTHX_ struct state *st, HEK *hek, U32 shared)
 649 {
 650     /* Hash keys can be shared. Have we seen this before? */
 651     if (!check_new(st, hek))
 652         return;
 653     st->total_size += HEK_BASESIZE + hek->hek_len
 654 #if PERL_VERSION < 8
 655         + 1 /* No hash key flags prior to 5.8.0  */
 656 #else
 657         + 2
 658 #endif
 659         ;
 660     if (shared) {
 661 #if PERL_VERSION < 10
 662         st->total_size += sizeof(struct he);
 663 #else
 664         st->total_size += STRUCT_OFFSET(struct shared_he, shared_he_hek);
 665 #endif
 666     }
 667 }
 668
 669
 670 #if PERL_VERSION < 8 || PERL_SUBVERSION < 9
 671 #  define SVt_LAST 16
 672 #endif
 673
 674 #ifdef PURIFY
 675 #  define MAYBE_PURIFY(normal, pure) (pure)
 676 #  define MAYBE_OFFSET(struct_name, member) 0
 677 #else
 678 #  define MAYBE_PURIFY(normal, pure) (normal)
 679 #  define MAYBE_OFFSET(struct_name, member) STRUCT_OFFSET(struct_name, member)
 680 #endif
 681
 682 const U8 body_sizes[SVt_LAST] = {
 683 #if PERL_VERSION < 9
 684      0,                                                       /* SVt_NULL */
 685      MAYBE_PURIFY(sizeof(IV), sizeof(XPVIV)),                 /* SVt_IV */
 686      MAYBE_PURIFY(sizeof(NV), sizeof(XPVNV)),                 /* SVt_NV */
 687      sizeof(XRV),                                             /* SVt_RV */
 688      sizeof(XPV),                                             /* SVt_PV */
 689      sizeof(XPVIV),                                           /* SVt_PVIV */
 690      sizeof(XPVNV),                                           /* SVt_PVNV */
 691      sizeof(XPVMG),                                           /* SVt_PVMG */
 692      sizeof(XPVBM),                                           /* SVt_PVBM */
 693      sizeof(XPVLV),                                           /* SVt_PVLV */
 694      sizeof(XPVAV),                                           /* SVt_PVAV */
 695      sizeof(XPVHV),                                           /* SVt_PVHV */
 696      sizeof(XPVCV),                                           /* SVt_PVCV */
 697      sizeof(XPVGV),                                           /* SVt_PVGV */
 698      sizeof(XPVFM),                                           /* SVt_PVFM */
 699      sizeof(XPVIO)                                            /* SVt_PVIO */
 700 #elif PERL_VERSION == 10 && PERL_SUBVERSION == 0
 701      0,                                                       /* SVt_NULL */
 702      0,                                                       /* SVt_BIND */
 703      0,                                                       /* SVt_IV */
 704      MAYBE_PURIFY(sizeof(NV), sizeof(XPVNV)),                 /* SVt_NV */
 705      0,                                                       /* SVt_RV */
 706      MAYBE_PURIFY(sizeof(xpv_allocated), sizeof(XPV)),        /* SVt_PV */
 707      MAYBE_PURIFY(sizeof(xpviv_allocated), sizeof(XPVIV)),/* SVt_PVIV */
 708      sizeof(XPVNV),                                           /* SVt_PVNV */
 709      sizeof(XPVMG),                                           /* SVt_PVMG */
 710      sizeof(XPVGV),                                           /* SVt_PVGV */
 711      sizeof(XPVLV),                                           /* SVt_PVLV */
 712      MAYBE_PURIFY(sizeof(xpvav_allocated), sizeof(XPVAV)),/* SVt_PVAV */
 713      MAYBE_PURIFY(sizeof(xpvhv_allocated), sizeof(XPVHV)),/* SVt_PVHV */
 714      MAYBE_PURIFY(sizeof(xpvcv_allocated), sizeof(XPVCV)),/* SVt_PVCV */
 715      MAYBE_PURIFY(sizeof(xpvfm_allocated), sizeof(XPVFM)),/* SVt_PVFM */
 716      sizeof(XPVIO),                                           /* SVt_PVIO */
 717 #elif PERL_VERSION == 10 && PERL_SUBVERSION == 1
 718      0,                                                       /* SVt_NULL */
 719      0,                                                       /* SVt_BIND */
 720      0,                                                       /* SVt_IV */
 721      MAYBE_PURIFY(sizeof(NV), sizeof(XPVNV)),                 /* SVt_NV */
 722      0,                                                       /* SVt_RV */
 723      sizeof(XPV) - MAYBE_OFFSET(XPV, xpv_cur),                /* SVt_PV */
 724      sizeof(XPVIV) - MAYBE_OFFSET(XPV, xpv_cur),              /* SVt_PVIV */
 725      sizeof(XPVNV),                                           /* SVt_PVNV */
 726      sizeof(XPVMG),                                           /* SVt_PVMG */
 727      sizeof(XPVGV),                                           /* SVt_PVGV */
 728      sizeof(XPVLV),                                           /* SVt_PVLV */
 729      sizeof(XPVAV) - MAYBE_OFFSET(XPVAV, xav_fill),           /* SVt_PVAV */
 730      sizeof(XPVHV) - MAYBE_OFFSET(XPVHV, xhv_fill),           /* SVt_PVHV */
 731      sizeof(XPVCV) - MAYBE_OFFSET(XPVCV, xpv_cur),            /* SVt_PVCV */
 732      sizeof(XPVFM) - MAYBE_OFFSET(XPVFM, xpv_cur),            /* SVt_PVFM */
 733      sizeof(XPVIO)                                            /* SVt_PVIO */
 734 #elif PERL_VERSION < 13
 735      0,                                                       /* SVt_NULL */
 736      0,                                                       /* SVt_BIND */
 737      0,                                                       /* SVt_IV */
 738      MAYBE_PURIFY(sizeof(NV), sizeof(XPVNV)),                 /* SVt_NV */
 739      sizeof(XPV) - MAYBE_OFFSET(XPV, xpv_cur),                /* SVt_PV */
 740      sizeof(XPVIV) - MAYBE_OFFSET(XPV, xpv_cur),              /* SVt_PVIV */
 741      sizeof(XPVNV),                                           /* SVt_PVNV */
 742      sizeof(XPVMG),                                           /* SVt_PVMG */
 743      sizeof(regexp) - MAYBE_OFFSET(regexp, xpv_cur),          /* SVt_REGEXP */
 744      sizeof(XPVGV),                                           /* SVt_PVGV */
 745      sizeof(XPVLV),                                           /* SVt_PVLV */
 746      sizeof(XPVAV) - MAYBE_OFFSET(XPVAV, xav_fill),           /* SVt_PVAV */
 747      sizeof(XPVHV) - MAYBE_OFFSET(XPVHV, xhv_fill),           /* SVt_PVHV */
 748      sizeof(XPVCV) - MAYBE_OFFSET(XPVCV, xpv_cur),            /* SVt_PVCV */
 749      sizeof(XPVFM) - MAYBE_OFFSET(XPVFM, xpv_cur),            /* SVt_PVFM */
 750      sizeof(XPVIO)                                            /* SVt_PVIO */
 751 #else
 752      0,                                                       /* SVt_NULL */
 753      0,                                                       /* SVt_BIND */
 754      0,                                                       /* SVt_IV */
 755      MAYBE_PURIFY(sizeof(NV), sizeof(XPVNV)),                 /* SVt_NV */
 756      sizeof(XPV) - MAYBE_OFFSET(XPV, xpv_cur),                /* SVt_PV */
 757      sizeof(XPVIV) - MAYBE_OFFSET(XPV, xpv_cur),              /* SVt_PVIV */
 758      sizeof(XPVNV) - MAYBE_OFFSET(XPV, xpv_cur),              /* SVt_PVNV */
 759      sizeof(XPVMG),                                           /* SVt_PVMG */
 760      sizeof(regexp),                                          /* SVt_REGEXP */
 761      sizeof(XPVGV),                                           /* SVt_PVGV */
 762      sizeof(XPVLV),                                           /* SVt_PVLV */
 763      sizeof(XPVAV),                                           /* SVt_PVAV */
 764      sizeof(XPVHV),                                           /* SVt_PVHV */
 765      sizeof(XPVCV),                                           /* SVt_PVCV */
 766      sizeof(XPVFM),                                           /* SVt_PVFM */
 767      sizeof(XPVIO)                                            /* SVt_PVIO */
 768 #endif
 769 };
 770
 771 #if PERL_COMBI_VERSION < 5008001
 772 typedef AV PADLIST;
 773 #endif
 774
 775 static void
 776 padlist_size(pTHX_ struct state *const st, const PADLIST * const padl,
 777         const int recurse) {
 778
 779 #if PERL_VERSION*1000+PERL_SUBVERSION >= 21007
 780 /* This is, as ever, excessively nosey with the implementation, and hence
 781    fragile. */
 782     SSize_t i;
 783     const PADNAMELIST *pnl;
 784
 785     if (!check_new(st, padl))
 786         return;
 787     st->total_size += sizeof(PADLIST);
 788
 789     st->total_size += sizeof(PADNAMELIST);
 790     pnl = PadlistNAMES(padl);
 791     st->total_size += pnl->xpadnl_max * sizeof(PADNAME *);
 792     i = PadnamelistMAX(pnl) + 1;
 793     while (--i) {
 794         const PADNAME *const pn =
 795                 PadnamelistARRAY(pnl)[i];
 796         if (!pn || pn == &PL_padname_undef || pn == &PL_padname_const)
 797             continue;
 798         if (!check_new(st, pn))
 799             continue;
 800         st->total_size += STRUCT_OFFSET(struct padname_with_str, xpadn_str[0])
 801             + PadnameLEN(pn) + 1;
 802     }
 803
 804     i = PadlistMAX(padl) + 1;
 805     st->total_size += sizeof(PAD*) * i;
 806     while (--i)
 807         sv_size(aTHX_ st, (SV*)PadlistARRAY(padl)[i], recurse);
 808
 809 #elif defined PadlistNAMES
 810
 811     SSize_t i;
 812     if (!check_new(st, padl))
 813         return;
 814     st->total_size += sizeof(PADLIST);
 815     sv_size(aTHX_ st, (SV*)PadlistNAMES(padl), TOTAL_SIZE_RECURSION);
 816     i = PadlistMAX(padl) + 1;
 817     st->total_size += sizeof(PAD*) * i;
 818     while (--i)
 819         sv_size(aTHX_ st, (SV*)PadlistARRAY(padl)[i], recurse);
 820
 821 #else
 822
 823     sv_size(aTHX_ st, (SV*)padl, recurse);
 824
 825 #endif
 826 }
 827
 828 static void
 829 sv_size(pTHX_ struct state *const st, const SV * const orig_thing,
 830         const int recurse) {
 831   const SV *thing = orig_thing;
 832   U32 type;
 833
 834   if(!check_new(st, thing))
 835       return;
 836
 837   type = SvTYPE(thing);
 838   if (type > SVt_LAST) {
 839       warn("Devel::Size: Unknown variable type: %d encountered\n", type);
 840       return;
 841   }
 842   st->total_size += sizeof(SV) + body_sizes[type];
 843
 844   if (SvMAGICAL(thing)) {
 845       magic_size(aTHX_ thing, st);
 846   }
 847
 848   switch (type) {
 849 #if (PERL_VERSION < 11)
 850     /* Is it a reference? */
 851   case SVt_RV: TAG;
 852 #else
 853   case SVt_IV: TAG;
 854 #endif
 855     if(recurse && SvROK(thing))
 856         sv_size(aTHX_ st, SvRV_const(thing), recurse);
 857     TAG;break;
 858
 859   case SVt_PVAV: TAG;
 860     /* Is there anything in the array? */
 861     if (AvMAX(thing) != -1) {
 862       /* an array with 10 slots has AvMax() set to 9 - te 2007-04-22 */
 863       st->total_size += sizeof(SV *) * (AvMAX(thing) + 1);
 864       dbg_printf(("total_size: %li AvMAX: %li av_len: $i\n", st->total_size, AvMAX(thing), av_len((AV*)thing)));
 865
 866       if (recurse >= TOTAL_SIZE_RECURSION) {
 867           SSize_t i = AvFILLp(thing) + 1;
 868
 869           while (i--)
 870               sv_size(aTHX_ st, AvARRAY(thing)[i], recurse);
 871       }
 872     }
 873     /* Add in the bits on the other side of the beginning */
 874
 875     dbg_printf(("total_size %li, sizeof(SV *) %li, AvARRAY(thing) %li, AvALLOC(thing)%li , sizeof(ptr) %li \n",
 876     st->total_size, sizeof(SV*), AvARRAY(thing), AvALLOC(thing), sizeof( thing )));
 877
 878     /* under Perl 5.8.8 64bit threading, AvARRAY(thing) was a pointer while AvALLOC was 0,
 879        resulting in grossly overstated sized for arrays. Technically, this shouldn't happen... */
 880     if (AvALLOC(thing) != 0) {
 881       st->total_size += (sizeof(SV *) * (AvARRAY(thing) - AvALLOC(thing)));
 882       }
 883 #if (PERL_VERSION < 9)
 884     /* Is there something hanging off the arylen element?
 885        Post 5.9.something this is stored in magic, so will be found there,
 886        and Perl_av_arylen_p() takes a non-const AV*, hence compilers rightly
 887        complain about AvARYLEN() passing thing to it.  */
 888     sv_size(aTHX_ st, AvARYLEN(thing), recurse);
 889 #endif
 890     TAG;break;
 891   case SVt_PVHV: TAG;
 892     /* Now the array of buckets */
 893     st->total_size += (sizeof(HE *) * (HvMAX(thing) + 1));
 894     /* Now walk the bucket chain */
 895     if (HvARRAY(thing)) {
 896       HE *cur_entry;
 897       UV cur_bucket = 0;
 898       for (cur_bucket = 0; cur_bucket <= HvMAX(thing); cur_bucket++) {
 899         cur_entry = *(HvARRAY(thing) + cur_bucket);
 900         while (cur_entry) {
 901           st->total_size += sizeof(HE);
 902           hek_size(aTHX_ st, cur_entry->hent_hek, HvSHAREKEYS(thing));
 903           if (recurse >= TOTAL_SIZE_RECURSION)
 904               sv_size(aTHX_ st, HeVAL(cur_entry), recurse);
 905           cur_entry = cur_entry->hent_next;
 906         }
 907       }
 908     }
 909 #ifdef HvAUX
 910     if (SvOOK(thing)) {
 911         /* This direct access is arguably "naughty": */
 912         struct mro_meta *meta = HvAUX(thing)->xhv_mro_meta;
 913 #if PERL_VERSION > 13 || PERL_SUBVERSION > 8
 914         /* As is this: */
 915         I32 count = HvAUX(thing)->xhv_name_count;
 916
 917         if (count) {
 918             HEK **names = HvAUX(thing)->xhv_name_u.xhvnameu_names;
 919             if (count < 0)
 920                 count = -count;
 921             while (--count)
 922                 hek_size(aTHX_ st, names[count], 1);
 923         }
 924         else
 925 #endif
 926         {
 927             hek_size(aTHX_ st, HvNAME_HEK(thing), 1);
 928         }
 929
 930         st->total_size += sizeof(struct xpvhv_aux);
 931         if (meta) {
 932             st->total_size += sizeof(struct mro_meta);
 933             sv_size(aTHX_ st, (SV *)meta->mro_nextmethod, TOTAL_SIZE_RECURSION);
 934 #if PERL_VERSION > 10 || (PERL_VERSION == 10 && PERL_SUBVERSION > 0)
 935             sv_size(aTHX_ st, (SV *)meta->isa, TOTAL_SIZE_RECURSION);
 936 #endif
 937 #if PERL_VERSION > 10
 938             sv_size(aTHX_ st, (SV *)meta->mro_linear_all, TOTAL_SIZE_RECURSION);
 939             sv_size(aTHX_ st, meta->mro_linear_current, TOTAL_SIZE_RECURSION);
 940 #else
 941             sv_size(aTHX_ st, (SV *)meta->mro_linear_dfs, TOTAL_SIZE_RECURSION);
 942             sv_size(aTHX_ st, (SV *)meta->mro_linear_c3, TOTAL_SIZE_RECURSION);
 943 #endif
 944         }
 945     }
 946 #else
 947     check_new_and_strlen(st, HvNAME_get(thing));
 948 #endif
 949     TAG;break;
 950
 951
 952   case SVt_PVFM: TAG;
 953     if (PERL_VERSION*1000+PERL_SUBVERSION < 21006 || !CvISXSUB(thing))
 954         padlist_size(aTHX_ st, CvPADLIST(thing), SOME_RECURSION);
 955     sv_size(aTHX_ st, (SV *)CvOUTSIDE(thing), recurse);
 956
 957     if (st->go_yell && !st->fm_whine) {
 958       carp("Devel::Size: Calculated sizes for FMs are incomplete");
 959       st->fm_whine = 1;
 960     }
 961     goto freescalar;
 962
 963   case SVt_PVCV: TAG;
 964     sv_size(aTHX_ st, (SV *)CvSTASH(thing), SOME_RECURSION);
 965     sv_size(aTHX_ st, (SV *)SvSTASH(thing), SOME_RECURSION);
 966     sv_size(aTHX_ st, (SV *)CvGV(thing), SOME_RECURSION);
 967     if (PERL_VERSION*1000+PERL_SUBVERSION < 21006 || !CvISXSUB(thing))
 968         padlist_size(aTHX_ st, CvPADLIST(thing), SOME_RECURSION);
 969     sv_size(aTHX_ st, (SV *)CvOUTSIDE(thing), recurse);
 970     if (CvISXSUB(thing)) {
 971         sv_size(aTHX_ st, cv_const_sv((CV *)thing), recurse);
 972     } else if (CvROOT(thing)) {
 973         op_size(aTHX_ CvSTART(thing), st);
 974         op_size(aTHX_ CvROOT(thing), st);
 975     }
 976     goto freescalar;
 977
 978   case SVt_PVIO: TAG;
 979     /* Some embedded char pointers */
 980     check_new_and_strlen(st, ((XPVIO *) SvANY(thing))->xio_top_name);
 981     check_new_and_strlen(st, ((XPVIO *) SvANY(thing))->xio_fmt_name);
 982     check_new_and_strlen(st, ((XPVIO *) SvANY(thing))->xio_bottom_name);
 983     /* Throw the GVs on the list to be walked if they're not-null */
 984     sv_size(aTHX_ st, (SV *)((XPVIO *) SvANY(thing))->xio_top_gv, recurse);
 985     sv_size(aTHX_ st, (SV *)((XPVIO *) SvANY(thing))->xio_bottom_gv, recurse);
 986     sv_size(aTHX_ st, (SV *)((XPVIO *) SvANY(thing))->xio_fmt_gv, recurse);
 987
 988     /* Only go trotting through the IO structures if they're really
 989        trottable. If USE_PERLIO is defined we can do this. If
 990        not... we can't, so we don't even try */
 991 #ifdef USE_PERLIO
 992     /* Dig into xio_ifp and xio_ofp here */
 993     warn("Devel::Size: Can't size up perlio layers yet\n");
 994 #endif
 995     goto freescalar;
 996
 997   case SVt_PVLV: TAG;
 998 #if (PERL_VERSION < 9)
 999     goto freescalar;
1000 #endif
1001
1002   case SVt_PVGV: TAG;
1003     if(isGV_with_GP(thing)) {
1004 #ifdef GvNAME_HEK
1005         hek_size(aTHX_ st, GvNAME_HEK(thing), 1);
1006 #else
1007         st->total_size += GvNAMELEN(thing);
1008 #endif
1009 #ifdef GvFILE_HEK
1010         hek_size(aTHX_ st, GvFILE_HEK(thing), 1);
1011 #elif defined(GvFILE)
1012 #  if !defined(USE_ITHREADS) || (PERL_VERSION > 8 || (PERL_VERSION == 8 && PERL_SUBVERSION > 8))
1013         /* With itreads, before 5.8.9, this can end up pointing to freed memory
1014            if the GV was created in an eval, as GvFILE() points to CopFILE(),
1015            and the relevant COP has been freed on scope cleanup after the eval.
1016            5.8.9 adds a binary compatible fudge that catches the vast majority
1017            of cases. 5.9.something added a proper fix, by converting the GP to
1018            use a shared hash key (porperly reference counted), instead of a
1019            char * (owned by who knows? possibly no-one now) */
1020         check_new_and_strlen(st, GvFILE(thing));
1021 #  endif
1022 #endif
1023         /* Is there something hanging off the glob? */
1024         if (check_new(st, GvGP(thing))) {
1025             st->total_size += sizeof(GP);
1026             sv_size(aTHX_ st, (SV *)(GvGP(thing)->gp_sv), recurse);
1027             sv_size(aTHX_ st, (SV *)(GvGP(thing)->gp_form), recurse);
1028             sv_size(aTHX_ st, (SV *)(GvGP(thing)->gp_av), recurse);
1029             sv_size(aTHX_ st, (SV *)(GvGP(thing)->gp_hv), recurse);
1030             sv_size(aTHX_ st, (SV *)(GvGP(thing)->gp_egv), recurse);
1031             sv_size(aTHX_ st, (SV *)(GvGP(thing)->gp_cv), recurse);
1032         }
1033 #if (PERL_VERSION >= 9)
1034         TAG; break;
1035 #endif
1036     }
1037 #if PERL_VERSION <= 8
1038   case SVt_PVBM: TAG;
1039 #endif
1040   case SVt_PVMG: TAG;
1041   case SVt_PVNV: TAG;
1042   case SVt_PVIV: TAG;
1043   case SVt_PV: TAG;
1044   freescalar:
1045     if(recurse && SvROK(thing))
1046         sv_size(aTHX_ st, SvRV_const(thing), recurse);
1047     else if (SvIsCOW_shared_hash(thing))
1048         hek_size(aTHX_ st, SvSHARED_HEK_FROM_PV(SvPVX(thing)), 1);
1049     else
1050         st->total_size += SvLEN(thing);
1051
1052     if(SvOOK(thing)) {
1053         STRLEN len;
1054         SvOOK_offset(thing, len);
1055         st->total_size += len;
1056     }
1057     TAG;break;
1058
1059   }
1060   return;
1061 }
1062
1063 static struct state *
1064 new_state(pTHX)
1065 {
1066     SV *warn_flag;
1067     struct state *st;
1068
1069     Newxz(st, 1, struct state);
1070     st->go_yell = TRUE;
1071     if (NULL != (warn_flag = perl_get_sv("Devel::Size::warn", FALSE))) {
1072         st->dangle_whine = st->go_yell = SvIV(warn_flag) ? TRUE : FALSE;
1073     }
1074     if (NULL != (warn_flag = perl_get_sv("Devel::Size::dangle", FALSE))) {
1075         st->dangle_whine = SvIV(warn_flag) ? TRUE : FALSE;
1076     }
1077     check_new(st, &PL_sv_undef);
1078     check_new(st, &PL_sv_no);
1079     check_new(st, &PL_sv_yes);
1080 #if PERL_VERSION > 8 || (PERL_VERSION == 8 && PERL_SUBVERSION > 0)
1081     check_new(st, &PL_sv_placeholder);
1082 #endif
1083     return st;
1084 }
1085
1086 MODULE = Devel::Size        PACKAGE = Devel::Size
1087
1088 PROTOTYPES: DISABLE
1089
1090 UV
1091 size(orig_thing)
1092      SV *orig_thing
1093 ALIAS:
1094     total_size = TOTAL_SIZE_RECURSION
1095 CODE:
1096 {
1097   SV *thing = orig_thing;
1098   struct state *st = new_state(aTHX);
1099
1100   /* If they passed us a reference then dereference it. This is the
1101      only way we can check the sizes of arrays and hashes */
1102   if (SvROK(thing)) {
1103     thing = SvRV(thing);
1104   }
1105
1106   sv_size(aTHX_ st, thing, ix);
1107   RETVAL = st->total_size;
1108   free_state(st);
1109 }
1110 OUTPUT:
1111   RETVAL