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