6 /* Not yet in ppport.h */
8 # define CvISXSUB(cv) (CvXSUB(cv) ? TRUE : FALSE)
12 /* "structured exception" handling is a Microsoft extension to C and C++.
13 It's *not* C++ exception handling - C++ exception handling can't capture
14 SEGVs and suchlike, whereas this can. There's no known analagous
15 functionality on other platforms. */
17 # define TRY_TO_CATCH_SEGV __try
18 # define CAUGHT_EXCEPTION __except(EXCEPTION EXCEPTION_EXECUTE_HANDLER)
20 # define TRY_TO_CATCH_SEGV if(1)
21 # define CAUGHT_EXCEPTION else
25 # define __attribute__(x)
28 static int regex_whine;
30 static int dangle_whine = 0;
32 #if 0 && defined(DEBUGGING)
33 #define dbg_printf(x) printf x
38 #define TAG /* printf( "# %s(%d)\n", __FILE__, __LINE__ ) */
41 /* The idea is to have a tree structure to store 1 bit per possible pointer
42 address. The lowest 16 bits are stored in a block of 8092 bytes.
43 The blocks are in a 256-way tree, indexed by the reset of the pointer.
44 This can cope with 32 and 64 bit pointers, and any address space layout,
45 without excessive memory needs. The assumption is that your CPU cache
46 works :-) (And that we're not going to bust it) */
48 #define ALIGN_BITS ( sizeof(void*) >> 1 )
50 #define LEAF_BITS (16 - BYTE_BITS)
51 #define LEAF_MASK 0x1FFF
53 typedef void * TRACKING[256];
56 Checks to see if thing is in the bitstring.
57 Returns true or false, and
58 notes thing in the segmented bitstring.
61 check_new(TRACKING *tv, const void *const p) {
62 unsigned int bits = 8 * sizeof(void*);
63 const size_t raw_p = PTR2nat(p);
64 /* This effectively rotates the value right by the number of low always-0
65 bits in an aligned pointer. The assmption is that most (if not all)
66 pointers are aligned, and these will be in the same chain of nodes
67 (and hence hot in the cache) but we can still deal with any unaligned
70 = (raw_p >> ALIGN_BITS) | (raw_p << (bits - BYTE_BITS));
71 const U8 this_bit = 1 << (cooked_p & 0x7);
75 void **tv_p = (void **) tv;
78 if (NULL == p) return FALSE;
80 const char c = *(const char *)p;
84 warn( "Devel::Size: Encountered invalid pointer: %p\n", p );
90 /* bits now 24 (32 bit pointers) or 56 (64 bit pointers) */
92 /* First level is always present. */
94 i = (unsigned int)((cooked_p >> bits) & 0xFF);
96 Newxz(tv_p[i], 256, void *);
97 tv_p = (void **)(tv_p[i]);
99 } while (bits > LEAF_BITS + BYTE_BITS);
100 /* bits now 16 always */
102 leaf_p = (U8 **)tv_p;
103 i = (unsigned int)((cooked_p >> bits) & 0xFF);
105 Newxz(leaf_p[i], 1 << LEAF_BITS, U8);
110 i = (unsigned int)((cooked_p >> BYTE_BITS) & LEAF_MASK);
112 if(leaf[i] & this_bit)
120 free_tracking_at(void **tv, int level)
128 free_tracking_at(tv[i], level);
142 free_tracking(TRACKING *tv)
144 const int top_level = (sizeof(void *) * 8 - LEAF_BITS - BYTE_BITS) / 8;
145 free_tracking_at((void **)tv, top_level);
149 UV thing_size(const SV *const, TRACKING *);
166 cc_opclass(const OP * const o)
172 return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
174 if (o->op_type == OP_SASSIGN)
175 return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPc_UNOP : OPc_BINOP);
178 if (o->op_type == OP_GV || o->op_type == OP_GVSV || o->op_type == OP_AELEMFAST)
182 if ((o->op_type == OP_TRANS)) {
186 switch (PL_opargs[o->op_type] & OA_CLASS_MASK) {
211 case OA_PVOP_OR_SVOP: TAG;
213 * Character translations (tr///) are usually a PVOP, keeping a
214 * pointer to a table of shorts used to look up translations.
215 * Under utf8, however, a simple table isn't practical; instead,
216 * the OP is an SVOP, and the SV is a reference to a swash
217 * (i.e., an RV pointing to an HV).
219 return (o->op_private & (OPpTRANS_TO_UTF|OPpTRANS_FROM_UTF))
220 ? OPc_SVOP : OPc_PVOP;
228 case OA_BASEOP_OR_UNOP: TAG;
230 * UNI(OP_foo) in toke.c returns token UNI or FUNC1 depending on
231 * whether parens were seen. perly.y uses OPf_SPECIAL to
232 * signal whether a BASEOP had empty parens or none.
233 * Some other UNOPs are created later, though, so the best
234 * test is OPf_KIDS, which is set in newUNOP.
236 return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
238 case OA_FILESTATOP: TAG;
240 * The file stat OPs are created via UNI(OP_foo) in toke.c but use
241 * the OPf_REF flag to distinguish between OP types instead of the
242 * usual OPf_SPECIAL flag. As usual, if OPf_KIDS is set, then we
243 * return OPc_UNOP so that walkoptree can find our children. If
244 * OPf_KIDS is not set then we check OPf_REF. Without OPf_REF set
245 * (no argument to the operator) it's an OP; with OPf_REF set it's
246 * an SVOP (and op_sv is the GV for the filehandle argument).
248 return ((o->op_flags & OPf_KIDS) ? OPc_UNOP :
250 (o->op_flags & OPf_REF) ? OPc_PADOP : OPc_BASEOP);
252 (o->op_flags & OPf_REF) ? OPc_SVOP : OPc_BASEOP);
254 case OA_LOOPEXOP: TAG;
256 * next, last, redo, dump and goto use OPf_SPECIAL to indicate that a
257 * label was omitted (in which case it's a BASEOP) or else a term was
258 * seen. In this last case, all except goto are definitely PVOP but
259 * goto is either a PVOP (with an ordinary constant label), an UNOP
260 * with OPf_STACKED (with a non-constant non-sub) or an UNOP for
261 * OP_REFGEN (with goto &sub) in which case OPf_STACKED also seems to
264 if (o->op_flags & OPf_STACKED)
266 else if (o->op_flags & OPf_SPECIAL)
271 warn("Devel::Size: Can't determine class of operator %s, assuming BASEOP\n",
272 PL_op_name[o->op_type]);
283 static int go_yell = 1;
285 /* Figure out how much magic is attached to the SV and return the
287 IV magic_size(const SV * const thing, TRACKING *tv) {
289 MAGIC *magic_pointer;
292 if (!SvMAGIC(thing)) {
297 /* Get the base magic pointer */
298 magic_pointer = SvMAGIC(thing);
300 /* Have we seen the magic pointer? */
301 while (magic_pointer && check_new(tv, magic_pointer)) {
302 total_size += sizeof(MAGIC);
305 /* Have we seen the magic vtable? */
306 if (magic_pointer->mg_virtual &&
307 check_new(tv, magic_pointer->mg_virtual)) {
308 total_size += sizeof(MGVTBL);
311 /* Get the next in the chain */
312 magic_pointer = magic_pointer->mg_moremagic;
316 warn( "Devel::Size: Encountered bad magic at: %p\n", magic_pointer );
322 UV regex_size(const REGEXP * const baseregex, TRACKING *tv) {
325 total_size += sizeof(REGEXP);
326 #if (PERL_VERSION < 11)
327 /* Note the size of the paren offset thing */
328 total_size += sizeof(I32) * baseregex->nparens * 2;
329 total_size += strlen(baseregex->precomp);
331 total_size += sizeof(struct regexp);
332 total_size += sizeof(I32) * SvANY(baseregex)->nparens * 2;
333 /*total_size += strlen(SvANY(baseregex)->subbeg);*/
335 if (go_yell && !regex_whine) {
336 carp("Devel::Size: Calculated sizes for compiled regexes are incompatible, and probably always will be");
343 UV op_size(const OP * const baseop, TRACKING *tv) {
347 if (check_new(tv, baseop->op_next)) {
348 total_size += op_size(baseop->op_next, tv);
351 switch (cc_opclass(baseop)) {
352 case OPc_BASEOP: TAG;
353 total_size += sizeof(struct op);
356 total_size += sizeof(struct unop);
357 if (check_new(tv, cUNOPx(baseop)->op_first)) {
358 total_size += op_size(cUNOPx(baseop)->op_first, tv);
362 total_size += sizeof(struct binop);
363 if (check_new(tv, cBINOPx(baseop)->op_first)) {
364 total_size += op_size(cBINOPx(baseop)->op_first, tv);
366 if (check_new(tv, cBINOPx(baseop)->op_last)) {
367 total_size += op_size(cBINOPx(baseop)->op_last, tv);
371 total_size += sizeof(struct logop);
372 if (check_new(tv, cLOGOPx(baseop)->op_first)) {
373 total_size += op_size(cBINOPx(baseop)->op_first, tv);
375 if (check_new(tv, cLOGOPx(baseop)->op_other)) {
376 total_size += op_size(cLOGOPx(baseop)->op_other, tv);
379 case OPc_LISTOP: TAG;
380 total_size += sizeof(struct listop);
381 if (check_new(tv, cLISTOPx(baseop)->op_first)) {
382 total_size += op_size(cLISTOPx(baseop)->op_first, tv);
384 if (check_new(tv, cLISTOPx(baseop)->op_last)) {
385 total_size += op_size(cLISTOPx(baseop)->op_last, tv);
389 total_size += sizeof(struct pmop);
390 if (check_new(tv, cPMOPx(baseop)->op_first)) {
391 total_size += op_size(cPMOPx(baseop)->op_first, tv);
393 if (check_new(tv, cPMOPx(baseop)->op_last)) {
394 total_size += op_size(cPMOPx(baseop)->op_last, tv);
396 #if PERL_VERSION < 9 || (PERL_VERSION == 9 && PERL_SUBVERSION < 5)
397 if (check_new(tv, cPMOPx(baseop)->op_pmreplroot)) {
398 total_size += op_size(cPMOPx(baseop)->op_pmreplroot, tv);
400 if (check_new(tv, cPMOPx(baseop)->op_pmreplstart)) {
401 total_size += op_size(cPMOPx(baseop)->op_pmreplstart, tv);
403 if (check_new(tv, cPMOPx(baseop)->op_pmnext)) {
404 total_size += op_size((OP *)cPMOPx(baseop)->op_pmnext, tv);
407 /* This is defined away in perl 5.8.x, but it is in there for
410 if (check_new(tv, PM_GETRE((cPMOPx(baseop))))) {
411 total_size += regex_size(PM_GETRE(cPMOPx(baseop)), tv);
414 if (check_new(tv, cPMOPx(baseop)->op_pmregexp)) {
415 total_size += regex_size(cPMOPx(baseop)->op_pmregexp, tv);
420 total_size += sizeof(struct pmop);
421 if (check_new(tv, cSVOPx(baseop)->op_sv)) {
422 total_size += thing_size(cSVOPx(baseop)->op_sv, tv);
426 total_size += sizeof(struct padop);
429 if (check_new(tv, cPVOPx(baseop)->op_pv)) {
430 total_size += strlen(cPVOPx(baseop)->op_pv);
433 total_size += sizeof(struct loop);
434 if (check_new(tv, cLOOPx(baseop)->op_first)) {
435 total_size += op_size(cLOOPx(baseop)->op_first, tv);
437 if (check_new(tv, cLOOPx(baseop)->op_last)) {
438 total_size += op_size(cLOOPx(baseop)->op_last, tv);
440 if (check_new(tv, cLOOPx(baseop)->op_redoop)) {
441 total_size += op_size(cLOOPx(baseop)->op_redoop, tv);
443 if (check_new(tv, cLOOPx(baseop)->op_nextop)) {
444 total_size += op_size(cLOOPx(baseop)->op_nextop, tv);
446 if (check_new(tv, cLOOPx(baseop)->op_lastop)) {
447 total_size += op_size(cLOOPx(baseop)->op_lastop, tv);
454 basecop = (COP *)baseop;
455 total_size += sizeof(struct cop);
457 /* Change 33656 by nicholas@mouse-mill on 2008/04/07 11:29:51
458 Eliminate cop_label from struct cop by storing a label as the first
459 entry in the hints hash. Most statements don't have labels, so this
460 will save memory. Not sure how much.
461 The check below will be incorrect fail on bleadperls
462 before 5.11 @33656, but later than 5.10, producing slightly too
463 small memory sizes on these Perls. */
464 #if (PERL_VERSION < 11)
465 if (check_new(tv, basecop->cop_label)) {
466 total_size += strlen(basecop->cop_label);
470 if (check_new(tv, basecop->cop_file)) {
471 total_size += strlen(basecop->cop_file);
473 if (check_new(tv, basecop->cop_stashpv)) {
474 total_size += strlen(basecop->cop_stashpv);
477 if (check_new(tv, basecop->cop_stash)) {
478 total_size += thing_size((SV *)basecop->cop_stash, tv);
480 if (check_new(tv, basecop->cop_filegv)) {
481 total_size += thing_size((SV *)basecop->cop_filegv, tv);
493 warn( "Devel::Size: Encountered dangling pointer in opcode at: %p\n", baseop );
498 #if PERL_VERSION > 9 || (PERL_VERSION == 9 && PERL_SUBVERSION > 2)
499 # define NEW_HEAD_LAYOUT
502 UV thing_size(const SV * const orig_thing, TRACKING *tv) {
503 const SV *thing = orig_thing;
504 UV total_size = sizeof(SV);
506 switch (SvTYPE(thing)) {
510 /* Just a plain integer. This will be differently sized depending
511 on whether purify's been compiled in */
513 #ifndef NEW_HEAD_LAYOUT
515 total_size += sizeof(sizeof(XPVIV));
517 total_size += sizeof(IV);
521 /* Is it a float? Like the int, it depends on purify */
524 total_size += sizeof(sizeof(XPVNV));
526 total_size += sizeof(NV);
529 #if (PERL_VERSION < 11)
530 /* Is it a reference? */
532 #ifndef NEW_HEAD_LAYOUT
533 total_size += sizeof(XRV);
537 /* How about a plain string? In which case we need to add in how
538 much has been allocated */
540 total_size += sizeof(XPV);
541 #if (PERL_VERSION < 11)
542 total_size += SvROK(thing) ? thing_size( SvRV(thing), tv) : SvLEN(thing);
544 total_size += SvLEN(thing);
547 /* A string with an integer part? */
549 total_size += sizeof(XPVIV);
550 #if (PERL_VERSION < 11)
551 total_size += SvROK(thing) ? thing_size( SvRV(thing), tv) : SvLEN(thing);
553 total_size += SvLEN(thing);
556 total_size += SvIVX(thing);
559 /* A scalar/string/reference with a float part? */
561 total_size += sizeof(XPVNV);
562 #if (PERL_VERSION < 11)
563 total_size += SvROK(thing) ? thing_size( SvRV(thing), tv) : SvLEN(thing);
565 total_size += SvLEN(thing);
569 total_size += sizeof(XPVMG);
570 #if (PERL_VERSION < 11)
571 total_size += SvROK(thing) ? thing_size( SvRV(thing), tv) : SvLEN(thing);
573 total_size += SvLEN(thing);
575 total_size += magic_size(thing, tv);
577 #if PERL_VERSION <= 8
579 total_size += sizeof(XPVBM);
580 #if (PERL_VERSION < 11)
581 total_size += SvROK(thing) ? thing_size( SvRV(thing), tv) : SvLEN(thing);
583 total_size += SvLEN(thing);
585 total_size += magic_size(thing, tv);
589 total_size += sizeof(XPVLV);
590 #if (PERL_VERSION < 11)
591 total_size += SvROK(thing) ? thing_size( SvRV(thing), tv) : SvLEN(thing);
593 total_size += SvLEN(thing);
595 total_size += magic_size(thing, tv);
597 /* How much space is dedicated to the array? Not counting the
598 elements in the array, mind, just the array itself */
600 total_size += sizeof(XPVAV);
601 /* Is there anything in the array? */
602 if (AvMAX(thing) != -1) {
603 /* an array with 10 slots has AvMax() set to 9 - te 2007-04-22 */
604 total_size += sizeof(SV *) * (AvMAX(thing) + 1);
605 dbg_printf(("total_size: %li AvMAX: %li av_len: $i\n", total_size, AvMAX(thing), av_len((AV*)thing)));
607 /* Add in the bits on the other side of the beginning */
609 dbg_printf(("total_size %li, sizeof(SV *) %li, AvARRAY(thing) %li, AvALLOC(thing)%li , sizeof(ptr) %li \n",
610 total_size, sizeof(SV*), AvARRAY(thing), AvALLOC(thing), sizeof( thing )));
612 /* under Perl 5.8.8 64bit threading, AvARRAY(thing) was a pointer while AvALLOC was 0,
613 resulting in grossly overstated sized for arrays. Technically, this shouldn't happen... */
614 if (AvALLOC(thing) != 0) {
615 total_size += (sizeof(SV *) * (AvARRAY(thing) - AvALLOC(thing)));
617 #if (PERL_VERSION < 9)
618 /* Is there something hanging off the arylen element?
619 Post 5.9.something this is stored in magic, so will be found there,
620 and Perl_av_arylen_p() takes a non-const AV*, hence compilers rightly
621 complain about AvARYLEN() passing thing to it. */
622 if (AvARYLEN(thing)) {
623 if (check_new(tv, AvARYLEN(thing))) {
624 total_size += thing_size(AvARYLEN(thing), tv);
628 total_size += magic_size(thing, tv);
631 /* First the base struct */
632 total_size += sizeof(XPVHV);
633 /* Now the array of buckets */
634 total_size += (sizeof(HE *) * (HvMAX(thing) + 1));
635 /* Now walk the bucket chain */
636 if (HvARRAY(thing)) {
639 for (cur_bucket = 0; cur_bucket <= HvMAX(thing); cur_bucket++) {
640 cur_entry = *(HvARRAY(thing) + cur_bucket);
642 total_size += sizeof(HE);
643 if (cur_entry->hent_hek) {
644 /* Hash keys can be shared. Have we seen this before? */
645 if (check_new(tv, cur_entry->hent_hek)) {
646 total_size += HEK_BASESIZE + cur_entry->hent_hek->hek_len + 2;
649 cur_entry = cur_entry->hent_next;
653 total_size += magic_size(thing, tv);
656 total_size += sizeof(XPVCV);
657 total_size += magic_size(thing, tv);
659 total_size += ((XPVIO *) SvANY(thing))->xpv_len;
660 if (check_new(tv, CvSTASH(thing))) {
661 total_size += thing_size((SV *)CvSTASH(thing), tv);
663 if (check_new(tv, SvSTASH(thing))) {
664 total_size += thing_size( (SV *)SvSTASH(thing), tv);
666 if (check_new(tv, CvGV(thing))) {
667 total_size += thing_size((SV *)CvGV(thing), tv);
669 if (check_new(tv, CvPADLIST(thing))) {
670 total_size += thing_size((SV *)CvPADLIST(thing), tv);
672 if (check_new(tv, CvOUTSIDE(thing))) {
673 total_size += thing_size((SV *)CvOUTSIDE(thing), tv);
675 if (CvISXSUB(thing)) {
676 SV *sv = cv_const_sv((CV *)thing);
678 total_size += thing_size(sv, tv);
681 if (check_new(tv, CvSTART(thing))) {
682 total_size += op_size(CvSTART(thing), tv);
684 if (check_new(tv, CvROOT(thing))) {
685 total_size += op_size(CvROOT(thing), tv);
691 total_size += magic_size(thing, tv);
692 total_size += sizeof(XPVGV);
693 total_size += GvNAMELEN(thing);
695 /* Is there a file? */
697 if (check_new(tv, GvFILE(thing))) {
698 total_size += strlen(GvFILE(thing));
702 /* Is there something hanging off the glob? */
704 if (check_new(tv, GvGP(thing))) {
705 total_size += sizeof(GP);
708 if ((generic_thing = (SV *)(GvGP(thing)->gp_sv))) {
709 total_size += thing_size(generic_thing, tv);
711 if ((generic_thing = (SV *)(GvGP(thing)->gp_form))) {
712 total_size += thing_size(generic_thing, tv);
714 if ((generic_thing = (SV *)(GvGP(thing)->gp_av))) {
715 total_size += thing_size(generic_thing, tv);
717 if ((generic_thing = (SV *)(GvGP(thing)->gp_hv))) {
718 total_size += thing_size(generic_thing, tv);
720 if ((generic_thing = (SV *)(GvGP(thing)->gp_egv))) {
721 total_size += thing_size(generic_thing, tv);
723 if ((generic_thing = (SV *)(GvGP(thing)->gp_cv))) {
724 total_size += thing_size(generic_thing, tv);
731 total_size += sizeof(XPVFM);
732 total_size += magic_size(thing, tv);
733 total_size += ((XPVIO *) SvANY(thing))->xpv_len;
734 if (check_new(tv, CvPADLIST(thing))) {
735 total_size += thing_size((SV *)CvPADLIST(thing), tv);
737 if (check_new(tv, CvOUTSIDE(thing))) {
738 total_size += thing_size((SV *)CvOUTSIDE(thing), tv);
741 if (go_yell && !fm_whine) {
742 carp("Devel::Size: Calculated sizes for FMs are incomplete");
747 total_size += sizeof(XPVIO);
748 total_size += magic_size(thing, tv);
749 if (check_new(tv, (SvPVX_const(thing)))) {
750 total_size += ((XPVIO *) SvANY(thing))->xpv_cur;
752 /* Some embedded char pointers */
753 if (check_new(tv, ((XPVIO *) SvANY(thing))->xio_top_name)) {
754 total_size += strlen(((XPVIO *) SvANY(thing))->xio_top_name);
756 if (check_new(tv, ((XPVIO *) SvANY(thing))->xio_fmt_name)) {
757 total_size += strlen(((XPVIO *) SvANY(thing))->xio_fmt_name);
759 if (check_new(tv, ((XPVIO *) SvANY(thing))->xio_bottom_name)) {
760 total_size += strlen(((XPVIO *) SvANY(thing))->xio_bottom_name);
762 /* Throw the GVs on the list to be walked if they're not-null */
763 if (((XPVIO *) SvANY(thing))->xio_top_gv) {
764 total_size += thing_size((SV *)((XPVIO *) SvANY(thing))->xio_top_gv,
767 if (((XPVIO *) SvANY(thing))->xio_bottom_gv) {
768 total_size += thing_size((SV *)((XPVIO *) SvANY(thing))->xio_bottom_gv,
771 if (((XPVIO *) SvANY(thing))->xio_fmt_gv) {
772 total_size += thing_size((SV *)((XPVIO *) SvANY(thing))->xio_fmt_gv,
776 /* Only go trotting through the IO structures if they're really
777 trottable. If USE_PERLIO is defined we can do this. If
778 not... we can't, so we don't even try */
780 /* Dig into xio_ifp and xio_ofp here */
781 warn("Devel::Size: Can't size up perlio layers yet\n");
785 warn("Devel::Size: Unknown variable type: %d encountered\n", SvTYPE(thing) );
790 MODULE = Devel::Size PACKAGE = Devel::Size
799 SV *thing = orig_thing;
802 Newz( 0xfc0ff, tv, 1, TRACKING );
804 /* Check warning status */
809 if (NULL != (warn_flag = perl_get_sv("Devel::Size::warn", FALSE))) {
810 dangle_whine = go_yell = SvIV(warn_flag);
812 if (NULL != (warn_flag = perl_get_sv("Devel::Size::dangle", FALSE))) {
813 dangle_whine = SvIV(warn_flag);
816 /* If they passed us a reference then dereference it. This is the
817 only way we can check the sizes of arrays and hashes */
818 #if (PERL_VERSION < 11)
819 if (SvOK(thing) && SvROK(thing)) {
828 RETVAL = thing_size(thing, tv);
836 total_size(orig_thing)
840 SV *thing = orig_thing;
842 /* Array with things we still need to do */
847 /* Size starts at zero */
850 /* Check warning status */
855 if (NULL != (warn_flag = perl_get_sv("Devel::Size::warn", FALSE))) {
856 dangle_whine = go_yell = SvIV(warn_flag);
858 if (NULL != (warn_flag = perl_get_sv("Devel::Size::dangle", FALSE))) {
859 dangle_whine = SvIV(warn_flag);
862 /* init these after the go_yell above */
863 Newz( 0xfc0ff, tv, 1, TRACKING );
864 pending_array = newAV();
866 /* We cannot push HV/AV directly, only the RV. So deref it
867 later (see below for "*** dereference later") and adjust here for
869 This is the only way we can check the sizes of arrays and hashes. */
871 RETVAL -= thing_size(thing, NULL);
874 /* Put it on the pending array */
875 av_push(pending_array, thing);
877 /* Now just yank things off the end of the array until it's done */
878 while (av_len(pending_array) >= 0) {
879 thing = av_pop(pending_array);
880 /* Process it if we've not seen it */
881 if (check_new(tv, thing)) {
882 dbg_printf(("# Found type %i at %p\n", SvTYPE(thing), thing));
885 /* Yes, it is. So let's check the type */
886 switch (SvTYPE(thing)) {
887 /* fix for bug #24846 (Does not correctly recurse into references in a PVNV-type scalar) */
891 av_push(pending_array, SvRV(thing));
895 /* this is the "*** dereference later" part - see above */
896 #if (PERL_VERSION < 11)
901 dbg_printf(("# Found RV\n"));
903 dbg_printf(("# Found RV\n"));
904 av_push(pending_array, SvRV(thing));
910 AV *tempAV = (AV *)thing;
913 dbg_printf(("# Found type AV\n"));
914 /* Quick alias to cut down on casting */
917 if (av_len(tempAV) != -1) {
919 /* Run through them all */
920 for (index = 0; index <= av_len(tempAV); index++) {
921 /* Did we get something? */
922 if ((tempSV = av_fetch(tempAV, index, 0))) {
924 if (*tempSV != &PL_sv_undef) {
925 /* Apparently not. Save it for later */
926 av_push(pending_array, *tempSV);
935 dbg_printf(("# Found type HV\n"));
936 /* Is there anything in here? */
937 if (hv_iterinit((HV *)thing)) {
939 while ((temp_he = hv_iternext((HV *)thing))) {
940 av_push(pending_array, hv_iterval((HV *)thing, temp_he));
946 dbg_printf(("# Found type GV\n"));
947 /* Run through all the pieces and push the ones with bits */
949 av_push(pending_array, (SV *)GvSV(thing));
952 av_push(pending_array, (SV *)GvFORM(thing));
955 av_push(pending_array, (SV *)GvAV(thing));
958 av_push(pending_array, (SV *)GvHV(thing));
961 av_push(pending_array, (SV *)GvCV(thing));
969 size = thing_size(thing, tv);
972 /* check_new() returned false: */
973 #ifdef DEVEL_SIZE_DEBUGGING
974 if (SvOK(sv)) printf("# Ignore ref copy 0x%x\n", sv);
975 else printf("# Ignore non-sv 0x%x\n", sv);
981 SvREFCNT_dec(pending_array);