1 #define PERL_NO_GET_CONTEXT
8 /* Not yet in ppport.h */
10 # define CvISXSUB(cv) (CvXSUB(cv) ? TRUE : FALSE)
14 /* "structured exception" handling is a Microsoft extension to C and C++.
15 It's *not* C++ exception handling - C++ exception handling can't capture
16 SEGVs and suchlike, whereas this can. There's no known analagous
17 functionality on other platforms. */
19 # define TRY_TO_CATCH_SEGV __try
20 # define CAUGHT_EXCEPTION __except(EXCEPTION EXCEPTION_EXECUTE_HANDLER)
22 # define TRY_TO_CATCH_SEGV if(1)
23 # define CAUGHT_EXCEPTION else
27 # define __attribute__(x)
30 #if 0 && defined(DEBUGGING)
31 #define dbg_printf(x) printf x
36 #define TAG /* printf( "# %s(%d)\n", __FILE__, __LINE__ ) */
39 /* The idea is to have a tree structure to store 1 bit per possible pointer
40 address. The lowest 16 bits are stored in a block of 8092 bytes.
41 The blocks are in a 256-way tree, indexed by the reset of the pointer.
42 This can cope with 32 and 64 bit pointers, and any address space layout,
43 without excessive memory needs. The assumption is that your CPU cache
44 works :-) (And that we're not going to bust it) */
46 #define ALIGN_BITS ( sizeof(void*) >> 1 )
48 #define LEAF_BITS (16 - BYTE_BITS)
49 #define LEAF_MASK 0x1FFF
56 /* My hunch (not measured) is that for most architectures pointers will
57 start with 0 bits, hence the start of this array will be hot, and the
58 end unused. So put the flags next to the hot end. */
63 Checks to see if thing is in the bitstring.
64 Returns true or false, and
65 notes thing in the segmented bitstring.
68 check_new(struct state *st, const void *const p) {
69 unsigned int bits = 8 * sizeof(void*);
70 const size_t raw_p = PTR2nat(p);
71 /* This effectively rotates the value right by the number of low always-0
72 bits in an aligned pointer. The assmption is that most (if not all)
73 pointers are aligned, and these will be in the same chain of nodes
74 (and hence hot in the cache) but we can still deal with any unaligned
77 = (raw_p >> ALIGN_BITS) | (raw_p << (bits - BYTE_BITS));
78 const U8 this_bit = 1 << (cooked_p & 0x7);
85 if (NULL == p || NULL == st) return FALSE;
86 tv_p = (void **) (st->tracking);
88 const char c = *(const char *)p;
92 warn( "Devel::Size: Encountered invalid pointer: %p\n", p );
98 /* bits now 24 (32 bit pointers) or 56 (64 bit pointers) */
100 /* First level is always present. */
102 i = (unsigned int)((cooked_p >> bits) & 0xFF);
104 Newxz(tv_p[i], 256, void *);
105 tv_p = (void **)(tv_p[i]);
107 } while (bits > LEAF_BITS + BYTE_BITS);
108 /* bits now 16 always */
109 #if !defined(MULTIPLICITY) || PERL_VERSION > 8 || (PERL_VERSION == 8 && PERL_SUBVERSION > 8)
110 /* 5.8.8 and early have an assert() macro that uses Perl_croak, hence needs
111 a my_perl under multiplicity */
114 leaf_p = (U8 **)tv_p;
115 i = (unsigned int)((cooked_p >> bits) & 0xFF);
117 Newxz(leaf_p[i], 1 << LEAF_BITS, U8);
122 i = (unsigned int)((cooked_p >> BYTE_BITS) & LEAF_MASK);
124 if(leaf[i] & this_bit)
132 free_tracking_at(void **tv, int level)
140 free_tracking_at(tv[i], level);
154 free_state(struct state *st)
156 const int top_level = (sizeof(void *) * 8 - LEAF_BITS - BYTE_BITS) / 8;
157 free_tracking_at((void **)st->tracking, top_level);
161 static UV thing_size(pTHX_ const SV *const, struct state *);
178 cc_opclass(const OP * const o)
184 return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
186 if (o->op_type == OP_SASSIGN)
187 return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPc_UNOP : OPc_BINOP);
190 if (o->op_type == OP_GV || o->op_type == OP_GVSV || o->op_type == OP_AELEMFAST)
194 if ((o->op_type == OP_TRANS)) {
198 switch (PL_opargs[o->op_type] & OA_CLASS_MASK) {
223 case OA_PVOP_OR_SVOP: TAG;
225 * Character translations (tr///) are usually a PVOP, keeping a
226 * pointer to a table of shorts used to look up translations.
227 * Under utf8, however, a simple table isn't practical; instead,
228 * the OP is an SVOP, and the SV is a reference to a swash
229 * (i.e., an RV pointing to an HV).
231 return (o->op_private & (OPpTRANS_TO_UTF|OPpTRANS_FROM_UTF))
232 ? OPc_SVOP : OPc_PVOP;
240 case OA_BASEOP_OR_UNOP: TAG;
242 * UNI(OP_foo) in toke.c returns token UNI or FUNC1 depending on
243 * whether parens were seen. perly.y uses OPf_SPECIAL to
244 * signal whether a BASEOP had empty parens or none.
245 * Some other UNOPs are created later, though, so the best
246 * test is OPf_KIDS, which is set in newUNOP.
248 return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
250 case OA_FILESTATOP: TAG;
252 * The file stat OPs are created via UNI(OP_foo) in toke.c but use
253 * the OPf_REF flag to distinguish between OP types instead of the
254 * usual OPf_SPECIAL flag. As usual, if OPf_KIDS is set, then we
255 * return OPc_UNOP so that walkoptree can find our children. If
256 * OPf_KIDS is not set then we check OPf_REF. Without OPf_REF set
257 * (no argument to the operator) it's an OP; with OPf_REF set it's
258 * an SVOP (and op_sv is the GV for the filehandle argument).
260 return ((o->op_flags & OPf_KIDS) ? OPc_UNOP :
262 (o->op_flags & OPf_REF) ? OPc_PADOP : OPc_BASEOP);
264 (o->op_flags & OPf_REF) ? OPc_SVOP : OPc_BASEOP);
266 case OA_LOOPEXOP: TAG;
268 * next, last, redo, dump and goto use OPf_SPECIAL to indicate that a
269 * label was omitted (in which case it's a BASEOP) or else a term was
270 * seen. In this last case, all except goto are definitely PVOP but
271 * goto is either a PVOP (with an ordinary constant label), an UNOP
272 * with OPf_STACKED (with a non-constant non-sub) or an UNOP for
273 * OP_REFGEN (with goto &sub) in which case OPf_STACKED also seems to
276 if (o->op_flags & OPf_STACKED)
278 else if (o->op_flags & OPf_SPECIAL)
283 warn("Devel::Size: Can't determine class of operator %s, assuming BASEOP\n",
284 PL_op_name[o->op_type]);
295 /* Figure out how much magic is attached to the SV and return the
297 IV magic_size(const SV * const thing, struct state *st) {
299 MAGIC *magic_pointer;
302 if (!SvMAGIC(thing)) {
307 /* Get the base magic pointer */
308 magic_pointer = SvMAGIC(thing);
310 /* Have we seen the magic pointer? */
311 while (magic_pointer && check_new(st, magic_pointer)) {
312 total_size += sizeof(MAGIC);
315 /* Have we seen the magic vtable? */
316 if (magic_pointer->mg_virtual &&
317 check_new(st, magic_pointer->mg_virtual)) {
318 total_size += sizeof(MGVTBL);
321 /* Get the next in the chain */
322 magic_pointer = magic_pointer->mg_moremagic;
325 if (st->dangle_whine)
326 warn( "Devel::Size: Encountered bad magic at: %p\n", magic_pointer );
332 UV regex_size(const REGEXP * const baseregex, struct state *st) {
335 total_size += sizeof(REGEXP);
336 #if (PERL_VERSION < 11)
337 /* Note the size of the paren offset thing */
338 total_size += sizeof(I32) * baseregex->nparens * 2;
339 total_size += strlen(baseregex->precomp);
341 total_size += sizeof(struct regexp);
342 total_size += sizeof(I32) * SvANY(baseregex)->nparens * 2;
343 /*total_size += strlen(SvANY(baseregex)->subbeg);*/
345 if (st->go_yell && !st->regex_whine) {
346 carp("Devel::Size: Calculated sizes for compiled regexes are incompatible, and probably always will be");
354 op_size(pTHX_ const OP * const baseop, struct state *st) {
358 if (check_new(st, baseop->op_next)) {
359 total_size += op_size(aTHX_ baseop->op_next, st);
362 switch (cc_opclass(baseop)) {
363 case OPc_BASEOP: TAG;
364 total_size += sizeof(struct op);
367 total_size += sizeof(struct unop);
368 if (check_new(st, cUNOPx(baseop)->op_first)) {
369 total_size += op_size(aTHX_ cUNOPx(baseop)->op_first, st);
373 total_size += sizeof(struct binop);
374 if (check_new(st, cBINOPx(baseop)->op_first)) {
375 total_size += op_size(aTHX_ cBINOPx(baseop)->op_first, st);
377 if (check_new(st, cBINOPx(baseop)->op_last)) {
378 total_size += op_size(aTHX_ cBINOPx(baseop)->op_last, st);
382 total_size += sizeof(struct logop);
383 if (check_new(st, cLOGOPx(baseop)->op_first)) {
384 total_size += op_size(aTHX_ cBINOPx(baseop)->op_first, st);
386 if (check_new(st, cLOGOPx(baseop)->op_other)) {
387 total_size += op_size(aTHX_ cLOGOPx(baseop)->op_other, st);
390 case OPc_LISTOP: TAG;
391 total_size += sizeof(struct listop);
392 if (check_new(st, cLISTOPx(baseop)->op_first)) {
393 total_size += op_size(aTHX_ cLISTOPx(baseop)->op_first, st);
395 if (check_new(st, cLISTOPx(baseop)->op_last)) {
396 total_size += op_size(aTHX_ cLISTOPx(baseop)->op_last, st);
400 total_size += sizeof(struct pmop);
401 if (check_new(st, cPMOPx(baseop)->op_first)) {
402 total_size += op_size(aTHX_ cPMOPx(baseop)->op_first, st);
404 if (check_new(st, cPMOPx(baseop)->op_last)) {
405 total_size += op_size(aTHX_ cPMOPx(baseop)->op_last, st);
407 #if PERL_VERSION < 9 || (PERL_VERSION == 9 && PERL_SUBVERSION < 5)
408 if (check_new(st, cPMOPx(baseop)->op_pmreplroot)) {
409 total_size += op_size(aTHX_ cPMOPx(baseop)->op_pmreplroot, st);
411 if (check_new(st, cPMOPx(baseop)->op_pmreplstart)) {
412 total_size += op_size(aTHX_ cPMOPx(baseop)->op_pmreplstart, st);
414 if (check_new(st, cPMOPx(baseop)->op_pmnext)) {
415 total_size += op_size(aTHX_ (OP *)cPMOPx(baseop)->op_pmnext, st);
418 /* This is defined away in perl 5.8.x, but it is in there for
421 if (check_new(st, PM_GETRE((cPMOPx(baseop))))) {
422 total_size += regex_size(PM_GETRE(cPMOPx(baseop)), st);
425 if (check_new(st, cPMOPx(baseop)->op_pmregexp)) {
426 total_size += regex_size(cPMOPx(baseop)->op_pmregexp, st);
431 total_size += sizeof(struct pmop);
432 if (check_new(st, cSVOPx(baseop)->op_sv)) {
433 total_size += thing_size(aTHX_ cSVOPx(baseop)->op_sv, st);
437 total_size += sizeof(struct padop);
440 if (check_new(st, cPVOPx(baseop)->op_pv)) {
441 total_size += strlen(cPVOPx(baseop)->op_pv);
444 total_size += sizeof(struct loop);
445 if (check_new(st, cLOOPx(baseop)->op_first)) {
446 total_size += op_size(aTHX_ cLOOPx(baseop)->op_first, st);
448 if (check_new(st, cLOOPx(baseop)->op_last)) {
449 total_size += op_size(aTHX_ cLOOPx(baseop)->op_last, st);
451 if (check_new(st, cLOOPx(baseop)->op_redoop)) {
452 total_size += op_size(aTHX_ cLOOPx(baseop)->op_redoop, st);
454 if (check_new(st, cLOOPx(baseop)->op_nextop)) {
455 total_size += op_size(aTHX_ cLOOPx(baseop)->op_nextop, st);
457 if (check_new(st, cLOOPx(baseop)->op_lastop)) {
458 total_size += op_size(aTHX_ cLOOPx(baseop)->op_lastop, st);
465 basecop = (COP *)baseop;
466 total_size += sizeof(struct cop);
468 /* Change 33656 by nicholas@mouse-mill on 2008/04/07 11:29:51
469 Eliminate cop_label from struct cop by storing a label as the first
470 entry in the hints hash. Most statements don't have labels, so this
471 will save memory. Not sure how much.
472 The check below will be incorrect fail on bleadperls
473 before 5.11 @33656, but later than 5.10, producing slightly too
474 small memory sizes on these Perls. */
475 #if (PERL_VERSION < 11)
476 if (check_new(st, basecop->cop_label)) {
477 total_size += strlen(basecop->cop_label);
481 if (check_new(st, basecop->cop_file)) {
482 total_size += strlen(basecop->cop_file);
484 if (check_new(st, basecop->cop_stashpv)) {
485 total_size += strlen(basecop->cop_stashpv);
488 if (check_new(st, basecop->cop_stash)) {
489 total_size += thing_size(aTHX_ (SV *)basecop->cop_stash, st);
491 if (check_new(st, basecop->cop_filegv)) {
492 total_size += thing_size(aTHX_ (SV *)basecop->cop_filegv, st);
503 if (st->dangle_whine)
504 warn( "Devel::Size: Encountered dangling pointer in opcode at: %p\n", baseop );
509 #if PERL_VERSION > 9 || (PERL_VERSION == 9 && PERL_SUBVERSION > 2)
510 # define NEW_HEAD_LAYOUT
514 thing_size(pTHX_ const SV * const orig_thing, struct state *st) {
515 const SV *thing = orig_thing;
516 UV total_size = sizeof(SV);
518 switch (SvTYPE(thing)) {
522 /* Just a plain integer. This will be differently sized depending
523 on whether purify's been compiled in */
525 #ifndef NEW_HEAD_LAYOUT
527 total_size += sizeof(sizeof(XPVIV));
529 total_size += sizeof(IV);
533 /* Is it a float? Like the int, it depends on purify */
536 total_size += sizeof(sizeof(XPVNV));
538 total_size += sizeof(NV);
541 #if (PERL_VERSION < 11)
542 /* Is it a reference? */
544 #ifndef NEW_HEAD_LAYOUT
545 total_size += sizeof(XRV);
549 /* How about a plain string? In which case we need to add in how
550 much has been allocated */
552 total_size += sizeof(XPV);
553 #if (PERL_VERSION < 11)
554 total_size += SvROK(thing) ? thing_size(aTHX_ SvRV(thing), st) : SvLEN(thing);
556 total_size += SvLEN(thing);
559 /* A string with an integer part? */
561 total_size += sizeof(XPVIV);
562 #if (PERL_VERSION < 11)
563 total_size += SvROK(thing) ? thing_size(aTHX_ SvRV(thing), st) : SvLEN(thing);
565 total_size += SvLEN(thing);
568 total_size += SvIVX(thing);
571 /* A scalar/string/reference with a float part? */
573 total_size += sizeof(XPVNV);
574 #if (PERL_VERSION < 11)
575 total_size += SvROK(thing) ? thing_size(aTHX_ SvRV(thing), st) : SvLEN(thing);
577 total_size += SvLEN(thing);
581 total_size += sizeof(XPVMG);
582 #if (PERL_VERSION < 11)
583 total_size += SvROK(thing) ? thing_size(aTHX_ SvRV(thing), st) : SvLEN(thing);
585 total_size += SvLEN(thing);
587 total_size += magic_size(thing, st);
589 #if PERL_VERSION <= 8
591 total_size += sizeof(XPVBM);
592 #if (PERL_VERSION < 11)
593 total_size += SvROK(thing) ? thing_size(aTHX_ SvRV(thing), st) : SvLEN(thing);
595 total_size += SvLEN(thing);
597 total_size += magic_size(thing, st);
601 total_size += sizeof(XPVLV);
602 #if (PERL_VERSION < 11)
603 total_size += SvROK(thing) ? thing_size(aTHX_ SvRV(thing), st) : SvLEN(thing);
605 total_size += SvLEN(thing);
607 total_size += magic_size(thing, st);
609 /* How much space is dedicated to the array? Not counting the
610 elements in the array, mind, just the array itself */
612 total_size += sizeof(XPVAV);
613 /* Is there anything in the array? */
614 if (AvMAX(thing) != -1) {
615 /* an array with 10 slots has AvMax() set to 9 - te 2007-04-22 */
616 total_size += sizeof(SV *) * (AvMAX(thing) + 1);
617 dbg_printf(("total_size: %li AvMAX: %li av_len: $i\n", total_size, AvMAX(thing), av_len((AV*)thing)));
619 /* Add in the bits on the other side of the beginning */
621 dbg_printf(("total_size %li, sizeof(SV *) %li, AvARRAY(thing) %li, AvALLOC(thing)%li , sizeof(ptr) %li \n",
622 total_size, sizeof(SV*), AvARRAY(thing), AvALLOC(thing), sizeof( thing )));
624 /* under Perl 5.8.8 64bit threading, AvARRAY(thing) was a pointer while AvALLOC was 0,
625 resulting in grossly overstated sized for arrays. Technically, this shouldn't happen... */
626 if (AvALLOC(thing) != 0) {
627 total_size += (sizeof(SV *) * (AvARRAY(thing) - AvALLOC(thing)));
629 #if (PERL_VERSION < 9)
630 /* Is there something hanging off the arylen element?
631 Post 5.9.something this is stored in magic, so will be found there,
632 and Perl_av_arylen_p() takes a non-const AV*, hence compilers rightly
633 complain about AvARYLEN() passing thing to it. */
634 if (AvARYLEN(thing)) {
635 if (check_new(st, AvARYLEN(thing))) {
636 total_size += thing_size(aTHX_ AvARYLEN(thing), st);
640 total_size += magic_size(thing, st);
643 /* First the base struct */
644 total_size += sizeof(XPVHV);
645 /* Now the array of buckets */
646 total_size += (sizeof(HE *) * (HvMAX(thing) + 1));
647 /* Now walk the bucket chain */
648 if (HvARRAY(thing)) {
651 for (cur_bucket = 0; cur_bucket <= HvMAX(thing); cur_bucket++) {
652 cur_entry = *(HvARRAY(thing) + cur_bucket);
654 total_size += sizeof(HE);
655 if (cur_entry->hent_hek) {
656 /* Hash keys can be shared. Have we seen this before? */
657 if (check_new(st, cur_entry->hent_hek)) {
658 total_size += HEK_BASESIZE + cur_entry->hent_hek->hek_len + 2;
661 cur_entry = cur_entry->hent_next;
665 total_size += magic_size(thing, st);
668 total_size += sizeof(XPVCV);
669 total_size += magic_size(thing, st);
671 total_size += ((XPVIO *) SvANY(thing))->xpv_len;
672 if (check_new(st, CvSTASH(thing))) {
673 total_size += thing_size(aTHX_ (SV *)CvSTASH(thing), st);
675 if (check_new(st, SvSTASH(thing))) {
676 total_size += thing_size(aTHX_ (SV *)SvSTASH(thing), st);
678 if (check_new(st, CvGV(thing))) {
679 total_size += thing_size(aTHX_ (SV *)CvGV(thing), st);
681 if (check_new(st, CvPADLIST(thing))) {
682 total_size += thing_size(aTHX_ (SV *)CvPADLIST(thing), st);
684 if (check_new(st, CvOUTSIDE(thing))) {
685 total_size += thing_size(aTHX_ (SV *)CvOUTSIDE(thing), st);
687 if (CvISXSUB(thing)) {
688 SV *sv = cv_const_sv((CV *)thing);
690 total_size += thing_size(aTHX_ sv, st);
693 if (check_new(st, CvSTART(thing))) {
694 total_size += op_size(aTHX_ CvSTART(thing), st);
696 if (check_new(st, CvROOT(thing))) {
697 total_size += op_size(aTHX_ CvROOT(thing), st);
703 total_size += magic_size(thing, st);
704 total_size += sizeof(XPVGV);
705 total_size += GvNAMELEN(thing);
707 /* Is there a file? */
709 if (check_new(st, GvFILE(thing))) {
710 total_size += strlen(GvFILE(thing));
714 /* Is there something hanging off the glob? */
716 if (check_new(st, GvGP(thing))) {
717 total_size += sizeof(GP);
720 if ((generic_thing = (SV *)(GvGP(thing)->gp_sv))) {
721 total_size += thing_size(aTHX_ generic_thing, st);
723 if ((generic_thing = (SV *)(GvGP(thing)->gp_form))) {
724 total_size += thing_size(aTHX_ generic_thing, st);
726 if ((generic_thing = (SV *)(GvGP(thing)->gp_av))) {
727 total_size += thing_size(aTHX_ generic_thing, st);
729 if ((generic_thing = (SV *)(GvGP(thing)->gp_hv))) {
730 total_size += thing_size(aTHX_ generic_thing, st);
732 if ((generic_thing = (SV *)(GvGP(thing)->gp_egv))) {
733 total_size += thing_size(aTHX_ generic_thing, st);
735 if ((generic_thing = (SV *)(GvGP(thing)->gp_cv))) {
736 total_size += thing_size(aTHX_ generic_thing, st);
743 total_size += sizeof(XPVFM);
744 total_size += magic_size(thing, st);
745 total_size += ((XPVIO *) SvANY(thing))->xpv_len;
746 if (check_new(st, CvPADLIST(thing))) {
747 total_size += thing_size(aTHX_ (SV *)CvPADLIST(thing), st);
749 if (check_new(st, CvOUTSIDE(thing))) {
750 total_size += thing_size(aTHX_ (SV *)CvOUTSIDE(thing), st);
753 if (st->go_yell && !st->fm_whine) {
754 carp("Devel::Size: Calculated sizes for FMs are incomplete");
759 total_size += sizeof(XPVIO);
760 total_size += magic_size(thing, st);
761 if (check_new(st, (SvPVX_const(thing)))) {
762 total_size += ((XPVIO *) SvANY(thing))->xpv_cur;
764 /* Some embedded char pointers */
765 if (check_new(st, ((XPVIO *) SvANY(thing))->xio_top_name)) {
766 total_size += strlen(((XPVIO *) SvANY(thing))->xio_top_name);
768 if (check_new(st, ((XPVIO *) SvANY(thing))->xio_fmt_name)) {
769 total_size += strlen(((XPVIO *) SvANY(thing))->xio_fmt_name);
771 if (check_new(st, ((XPVIO *) SvANY(thing))->xio_bottom_name)) {
772 total_size += strlen(((XPVIO *) SvANY(thing))->xio_bottom_name);
774 /* Throw the GVs on the list to be walked if they're not-null */
775 if (((XPVIO *) SvANY(thing))->xio_top_gv) {
776 total_size += thing_size(aTHX_ (SV *)((XPVIO *) SvANY(thing))->xio_top_gv,
779 if (((XPVIO *) SvANY(thing))->xio_bottom_gv) {
780 total_size += thing_size(aTHX_ (SV *)((XPVIO *) SvANY(thing))->xio_bottom_gv,
783 if (((XPVIO *) SvANY(thing))->xio_fmt_gv) {
784 total_size += thing_size(aTHX_ (SV *)((XPVIO *) SvANY(thing))->xio_fmt_gv,
788 /* Only go trotting through the IO structures if they're really
789 trottable. If USE_PERLIO is defined we can do this. If
790 not... we can't, so we don't even try */
792 /* Dig into xio_ifp and xio_ofp here */
793 warn("Devel::Size: Can't size up perlio layers yet\n");
797 warn("Devel::Size: Unknown variable type: %d encountered\n", SvTYPE(thing) );
802 static struct state *
807 Newxz(st, 1, struct state);
809 if (NULL != (warn_flag = perl_get_sv("Devel::Size::warn", FALSE))) {
810 st->dangle_whine = st->go_yell = SvIV(warn_flag) ? TRUE : FALSE;
812 if (NULL != (warn_flag = perl_get_sv("Devel::Size::dangle", FALSE))) {
813 st->dangle_whine = SvIV(warn_flag) ? TRUE : FALSE;
818 MODULE = Devel::Size PACKAGE = Devel::Size
827 SV *thing = orig_thing;
828 struct state *st = new_state(aTHX);
830 /* If they passed us a reference then dereference it. This is the
831 only way we can check the sizes of arrays and hashes */
832 #if (PERL_VERSION < 11)
833 if (SvOK(thing) && SvROK(thing)) {
842 RETVAL = thing_size(aTHX_ thing, st);
850 total_size(orig_thing)
854 SV *thing = orig_thing;
855 /* Array with things we still need to do */
858 struct state *st = new_state(aTHX);
860 /* Size starts at zero */
863 pending_array = newAV();
865 /* If they passed us a reference then dereference it.
866 This is the only way we can check the sizes of arrays and hashes. */
871 /* Put it on the pending array */
872 av_push(pending_array, thing);
874 /* Now just yank things off the end of the array until it's done */
875 while (av_len(pending_array) >= 0) {
876 thing = av_pop(pending_array);
877 /* Process it if we've not seen it */
878 if (check_new(st, thing)) {
879 dbg_printf(("# Found type %i at %p\n", SvTYPE(thing), thing));
882 /* Yes, it is. So let's check the type */
883 switch (SvTYPE(thing)) {
884 /* fix for bug #24846 (Does not correctly recurse into references in a PVNV-type scalar) */
888 av_push(pending_array, SvRV(thing));
891 #if (PERL_VERSION < 11)
896 dbg_printf(("# Found RV\n"));
898 dbg_printf(("# Found RV\n"));
899 av_push(pending_array, SvRV(thing));
905 AV *tempAV = (AV *)thing;
908 dbg_printf(("# Found type AV\n"));
909 /* Quick alias to cut down on casting */
912 if (av_len(tempAV) != -1) {
914 /* Run through them all */
915 for (index = 0; index <= av_len(tempAV); index++) {
916 /* Did we get something? */
917 if ((tempSV = av_fetch(tempAV, index, 0))) {
919 if (*tempSV != &PL_sv_undef) {
920 /* Apparently not. Save it for later */
921 av_push(pending_array, *tempSV);
930 dbg_printf(("# Found type HV\n"));
931 /* Is there anything in here? */
932 if (hv_iterinit((HV *)thing)) {
934 while ((temp_he = hv_iternext((HV *)thing))) {
935 av_push(pending_array, hv_iterval((HV *)thing, temp_he));
941 dbg_printf(("# Found type GV\n"));
942 /* Run through all the pieces and push the ones with bits */
944 av_push(pending_array, (SV *)GvSV(thing));
947 av_push(pending_array, (SV *)GvFORM(thing));
950 av_push(pending_array, (SV *)GvAV(thing));
953 av_push(pending_array, (SV *)GvHV(thing));
956 av_push(pending_array, (SV *)GvCV(thing));
964 size = thing_size(aTHX_ thing, st);
967 /* check_new() returned false: */
968 #ifdef DEVEL_SIZE_DEBUGGING
969 if (SvOK(sv)) printf("# Ignore ref copy 0x%x\n", sv);
970 else printf("# Ignore non-sv 0x%x\n", sv);
976 SvREFCNT_dec(pending_array);