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