X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=Size.xs;h=48b0ebf9756bbc66c9659146a144db3a2af5084e;hb=b76217297a5f92982c29177d97eb655b52d164eb;hp=02c16c33aacbf8a0f39a34175795a2d01200f32b;hpb=b98fcdb93f447c4f556f859c61b15c5fdd502bee;p=p5sagit%2FDevel-Size.git

diff --git a/Size.xs b/Size.xs
index 02c16c3..48b0ebf 100644
--- a/Size.xs
+++ b/Size.xs
@@ -2,12 +2,150 @@
 #include "perl.h"
 #include "XSUB.h"
 
+static int regex_whine;
+static int fm_whine;
+
+#if 0 && defined(DEBUGGING)
+#define dbg_printf(x) printf x
+#else
+#define dbg_printf(x)
+#endif
+
 #define carp puts
+UV thing_size(SV *, HV *);
+typedef enum {
+    OPc_NULL,	/* 0 */
+    OPc_BASEOP,	/* 1 */
+    OPc_UNOP,	/* 2 */
+    OPc_BINOP,	/* 3 */
+    OPc_LOGOP,	/* 4 */
+    OPc_LISTOP,	/* 5 */
+    OPc_PMOP,	/* 6 */
+    OPc_SVOP,	/* 7 */
+    OPc_PADOP,	/* 8 */
+    OPc_PVOP,	/* 9 */
+    OPc_LOOP,	/* 10 */
+    OPc_COP	/* 11 */
+} opclass;
+
+static opclass
+cc_opclass(OP *o)
+{
+    if (!o)
+	return OPc_NULL;
+
+    if (o->op_type == 0)
+	return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
+
+    if (o->op_type == OP_SASSIGN)
+	return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPc_UNOP : OPc_BINOP);
+
+#ifdef USE_ITHREADS
+    if (o->op_type == OP_GV || o->op_type == OP_GVSV || o->op_type == OP_AELEMFAST)
+	return OPc_PADOP;
+#endif
+
+    if ((o->op_type = OP_TRANS)) {
+      return OPc_BASEOP;
+    }
+
+    switch (PL_opargs[o->op_type] & OA_CLASS_MASK) {
+    case OA_BASEOP:
+	return OPc_BASEOP;
+
+    case OA_UNOP:
+	return OPc_UNOP;
+
+    case OA_BINOP:
+	return OPc_BINOP;
+
+    case OA_LOGOP:
+	return OPc_LOGOP;
+
+    case OA_LISTOP:
+	return OPc_LISTOP;
+
+    case OA_PMOP:
+	return OPc_PMOP;
+
+    case OA_SVOP:
+	return OPc_SVOP;
+
+    case OA_PADOP:
+	return OPc_PADOP;
+
+    case OA_PVOP_OR_SVOP:
+        /*
+         * Character translations (tr///) are usually a PVOP, keeping a 
+         * pointer to a table of shorts used to look up translations.
+         * Under utf8, however, a simple table isn't practical; instead,
+         * the OP is an SVOP, and the SV is a reference to a swash
+         * (i.e., an RV pointing to an HV).
+         */
+	return (o->op_private & (OPpTRANS_TO_UTF|OPpTRANS_FROM_UTF))
+		? OPc_SVOP : OPc_PVOP;
+
+    case OA_LOOP:
+	return OPc_LOOP;
+
+    case OA_COP:
+	return OPc_COP;
+
+    case OA_BASEOP_OR_UNOP:
+	/*
+	 * UNI(OP_foo) in toke.c returns token UNI or FUNC1 depending on
+	 * whether parens were seen. perly.y uses OPf_SPECIAL to
+	 * signal whether a BASEOP had empty parens or none.
+	 * Some other UNOPs are created later, though, so the best
+	 * test is OPf_KIDS, which is set in newUNOP.
+	 */
+	return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
+
+    case OA_FILESTATOP:
+	/*
+	 * The file stat OPs are created via UNI(OP_foo) in toke.c but use
+	 * the OPf_REF flag to distinguish between OP types instead of the
+	 * usual OPf_SPECIAL flag. As usual, if OPf_KIDS is set, then we
+	 * return OPc_UNOP so that walkoptree can find our children. If
+	 * OPf_KIDS is not set then we check OPf_REF. Without OPf_REF set
+	 * (no argument to the operator) it's an OP; with OPf_REF set it's
+	 * an SVOP (and op_sv is the GV for the filehandle argument).
+	 */
+	return ((o->op_flags & OPf_KIDS) ? OPc_UNOP :
+#ifdef USE_ITHREADS
+		(o->op_flags & OPf_REF) ? OPc_PADOP : OPc_BASEOP);
+#else
+		(o->op_flags & OPf_REF) ? OPc_SVOP : OPc_BASEOP);
+#endif
+    case OA_LOOPEXOP:
+	/*
+	 * next, last, redo, dump and goto use OPf_SPECIAL to indicate that a
+	 * label was omitted (in which case it's a BASEOP) or else a term was
+	 * seen. In this last case, all except goto are definitely PVOP but
+	 * goto is either a PVOP (with an ordinary constant label), an UNOP
+	 * with OPf_STACKED (with a non-constant non-sub) or an UNOP for
+	 * OP_REFGEN (with goto &sub) in which case OPf_STACKED also seems to
+	 * get set.
+	 */
+	if (o->op_flags & OPf_STACKED)
+	    return OPc_UNOP;
+	else if (o->op_flags & OPf_SPECIAL)
+	    return OPc_BASEOP;
+	else
+	    return OPc_PVOP;
+    }
+    warn("can't determine class of operator %s, assuming BASEOP\n",
+	 PL_op_name[o->op_type]);
+    return OPc_BASEOP;
+}
+
 
 #if !defined(NV)
 #define NV double
 #endif
 
+static int go_yell = 1;
+
 /* Checks to see if thing is in the hash. Returns true or false, and
    notes thing in the hash.
 
@@ -17,13 +155,15 @@
    pointer as the length. Perl then uses the four (or eight, on
    64-bit machines) bytes of the address as the string we're using as
    the key */
-IV check_new(HV *tracking_hash, void *thing) {
+IV check_new(HV *tracking_hash, const void *thing) {
+  if (NULL == thing || NULL == tracking_hash) {
+    return FALSE;
+  }
   if (hv_exists(tracking_hash, (char *)&thing, sizeof(void *))) {
     return FALSE;
   }
-  hv_store(tracking_hash, (char *)&thing, sizeof(void *), &PL_sv_undef, 0);
+  hv_store(tracking_hash, (char *)&thing, sizeof(void *), &PL_sv_yes, 0);
   return TRUE;
-
 }
 
 /* Figure out how much magic is attached to the SV and return the
@@ -58,11 +198,186 @@ IV magic_size(SV *thing, HV *tracking_hash) {
   return total_size;
 }
 
+UV regex_size(REGEXP *baseregex, HV *tracking_hash) {
+  UV total_size = 0;
+
+  total_size += sizeof(REGEXP);
+#if (PERL_VERSION < 11) 	
+  /* Note the size of the paren offset thing */
+  total_size += sizeof(I32) * baseregex->nparens * 2;
+  total_size += strlen(baseregex->precomp);
+#else
+  total_size += sizeof(struct regexp);
+  total_size += sizeof(I32) * SvANY(baseregex)->nparens * 2;
+  /*total_size += strlen(SvANY(baseregex)->subbeg);*/
+#endif
+  if (go_yell && !regex_whine) {
+    carp("Devel::Size: Calculated sizes for compiled regexes are incompatible, and probably always will be");
+    regex_whine = 1;
+  }
+
+  return total_size;
+}
+
+UV op_size(OP *baseop, HV *tracking_hash) {
+  UV total_size = 0;
+
+  if (check_new(tracking_hash, baseop->op_next)) {
+    total_size += op_size(baseop->op_next, tracking_hash);
+  }
+
+  switch (cc_opclass(baseop)) {
+  case OPc_BASEOP:
+    total_size += sizeof(struct op);
+    break;
+  case OPc_UNOP:
+    total_size += sizeof(struct unop);
+    if (check_new(tracking_hash, cUNOPx(baseop)->op_first)) {
+      total_size += op_size(cUNOPx(baseop)->op_first, tracking_hash);
+    }
+    break;
+  case OPc_BINOP:
+    total_size += sizeof(struct binop);
+    if (check_new(tracking_hash, cBINOPx(baseop)->op_first)) {
+      total_size += op_size(cBINOPx(baseop)->op_first, tracking_hash);
+    }  
+    if (check_new(tracking_hash, cBINOPx(baseop)->op_last)) {
+      total_size += op_size(cBINOPx(baseop)->op_last, tracking_hash);
+    }
+    break;
+  case OPc_LOGOP:
+    total_size += sizeof(struct logop);
+    if (check_new(tracking_hash, cLOGOPx(baseop)->op_first)) {
+      total_size += op_size(cBINOPx(baseop)->op_first, tracking_hash);
+    }  
+    if (check_new(tracking_hash, cLOGOPx(baseop)->op_other)) {
+      total_size += op_size(cLOGOPx(baseop)->op_other, tracking_hash);
+    }
+    break;
+  case OPc_LISTOP:
+    total_size += sizeof(struct listop);
+    if (check_new(tracking_hash, cLISTOPx(baseop)->op_first)) {
+      total_size += op_size(cLISTOPx(baseop)->op_first, tracking_hash);
+    }  
+    if (check_new(tracking_hash, cLISTOPx(baseop)->op_last)) {
+      total_size += op_size(cLISTOPx(baseop)->op_last, tracking_hash);
+    }
+    break;
+  case OPc_PMOP:
+    total_size += sizeof(struct pmop);
+    if (check_new(tracking_hash, cPMOPx(baseop)->op_first)) {
+      total_size += op_size(cPMOPx(baseop)->op_first, tracking_hash);
+    }  
+    if (check_new(tracking_hash, cPMOPx(baseop)->op_last)) {
+      total_size += op_size(cPMOPx(baseop)->op_last, tracking_hash);
+    }
+#if PERL_VERSION < 9 || (PERL_VERSION == 9 && PERL_SUBVERSION < 5)
+    if (check_new(tracking_hash, cPMOPx(baseop)->op_pmreplroot)) {
+      total_size += op_size(cPMOPx(baseop)->op_pmreplroot, tracking_hash);
+    }
+    if (check_new(tracking_hash, cPMOPx(baseop)->op_pmreplstart)) {
+      total_size += op_size(cPMOPx(baseop)->op_pmreplstart, tracking_hash);
+    }
+    if (check_new(tracking_hash, cPMOPx(baseop)->op_pmnext)) {
+      total_size += op_size((OP *)cPMOPx(baseop)->op_pmnext, tracking_hash);
+    }
+#endif
+    /* This is defined away in perl 5.8.x, but it is in there for
+       5.6.x */
+#ifdef PM_GETRE
+    if (check_new(tracking_hash, PM_GETRE((cPMOPx(baseop))))) {
+      total_size += regex_size(PM_GETRE(cPMOPx(baseop)), tracking_hash);
+    }
+#else
+    if (check_new(tracking_hash, cPMOPx(baseop)->op_pmregexp)) {
+      total_size += regex_size(cPMOPx(baseop)->op_pmregexp, tracking_hash);
+    }
+#endif
+    break;
+  case OPc_SVOP:
+    total_size += sizeof(struct pmop);
+    if (check_new(tracking_hash, cSVOPx(baseop)->op_sv)) {
+      total_size += thing_size(cSVOPx(baseop)->op_sv, tracking_hash);
+    }
+    break;
+  case OPc_PADOP:
+    total_size += sizeof(struct padop);
+    break;
+  case OPc_PVOP:
+    if (check_new(tracking_hash, cPVOPx(baseop)->op_pv)) {
+      total_size += strlen(cPVOPx(baseop)->op_pv);
+    }
+  case OPc_LOOP:
+    total_size += sizeof(struct loop);
+    if (check_new(tracking_hash, cLOOPx(baseop)->op_first)) {
+      total_size += op_size(cLOOPx(baseop)->op_first, tracking_hash);
+    }  
+    if (check_new(tracking_hash, cLOOPx(baseop)->op_last)) {
+      total_size += op_size(cLOOPx(baseop)->op_last, tracking_hash);
+    }
+    if (check_new(tracking_hash, cLOOPx(baseop)->op_redoop)) {
+      total_size += op_size(cLOOPx(baseop)->op_redoop, tracking_hash);
+    }  
+    if (check_new(tracking_hash, cLOOPx(baseop)->op_nextop)) {
+      total_size += op_size(cLOOPx(baseop)->op_nextop, tracking_hash);
+    }
+    /* Not working for some reason, but the code's here for later
+       fixing 
+    if (check_new(tracking_hash, cLOOPx(baseop)->op_lastop)) {
+      total_size += op_size(cLOOPx(baseop)->op_lastop, tracking_hash);
+    }  
+    */
+    break;
+  case OPc_COP:
+    {
+      COP *basecop;
+      basecop = (COP *)baseop;
+      total_size += sizeof(struct cop);
+
+      /* Change 33656 by nicholas@mouse-mill on 2008/04/07 11:29:51
+      Eliminate cop_label from struct cop by storing a label as the first
+      entry in the hints hash. Most statements don't have labels, so this
+      will save memory. Not sure how much. 
+      The check below will be incorrect fail on bleadperls
+      before 5.11 @33656, but later than 5.10, producing slightly too
+      small memory sizes on these Perls. */
+#if (PERL_VERSION < 11)
+      if (check_new(tracking_hash, basecop->cop_label)) {
+	total_size += strlen(basecop->cop_label);
+      }
+#endif
+#ifdef USE_ITHREADS
+      if (check_new(tracking_hash, basecop->cop_file)) {
+	total_size += strlen(basecop->cop_file);
+      }
+      if (check_new(tracking_hash, basecop->cop_stashpv)) {
+	total_size += strlen(basecop->cop_stashpv);
+      }
+#else
+      if (check_new(tracking_hash, basecop->cop_stash)) {
+	total_size += thing_size((SV *)basecop->cop_stash, tracking_hash);
+      }
+      if (check_new(tracking_hash, basecop->cop_filegv)) {
+	total_size += thing_size((SV *)basecop->cop_filegv, tracking_hash);
+      }
+#endif
+
+    }
+    break;
+  default:
+    break;
+  }
+  return total_size;
+}
+
+#if PERL_VERSION > 9 || (PERL_VERSION == 9 && PERL_SUBVERSION > 2)
+#  define NEW_HEAD_LAYOUT
+#endif
 
 UV thing_size(SV *orig_thing, HV *tracking_hash) {
   SV *thing = orig_thing;
   UV total_size = sizeof(SV);
-  
+
   switch (SvTYPE(thing)) {
     /* Is it undef? */
   case SVt_NULL:
@@ -70,10 +385,12 @@ UV thing_size(SV *orig_thing, HV *tracking_hash) {
     /* Just a plain integer. This will be differently sized depending
        on whether purify's been compiled in */
   case SVt_IV:
-#ifdef PURIFY
+#ifndef NEW_HEAD_LAYOUT
+#  ifdef PURIFY
     total_size += sizeof(sizeof(XPVIV));
-#else
+#  else
     total_size += sizeof(IV);
+#  endif
 #endif
     break;
     /* Is it a float? Like the int, it depends on purify */
@@ -84,39 +401,72 @@ UV thing_size(SV *orig_thing, HV *tracking_hash) {
     total_size += sizeof(NV);
 #endif
     break;
+#if (PERL_VERSION < 11) 	
     /* Is it a reference? */
   case SVt_RV:
+#ifndef NEW_HEAD_LAYOUT
     total_size += sizeof(XRV);
+#endif
     break;
+#endif
     /* How about a plain string? In which case we need to add in how
        much has been allocated */
   case SVt_PV:
     total_size += sizeof(XPV);
+#if (PERL_VERSION < 11)
+    total_size += SvROK(thing) ? thing_size( SvRV(thing), tracking_hash) : SvLEN(thing);
+#else
     total_size += SvLEN(thing);
+#endif
     break;
     /* A string with an integer part? */
   case SVt_PVIV:
     total_size += sizeof(XPVIV);
+#if (PERL_VERSION < 11)
+    total_size += SvROK(thing) ? thing_size( SvRV(thing), tracking_hash) : SvLEN(thing);
+#else
     total_size += SvLEN(thing);
+#endif
+    if(SvOOK(thing)) {
+        total_size += SvIVX(thing);
+	}
     break;
-    /* A string with a float part? */
+    /* A scalar/string/reference with a float part? */
   case SVt_PVNV:
     total_size += sizeof(XPVNV);
+#if (PERL_VERSION < 11)
+    total_size += SvROK(thing) ? thing_size( SvRV(thing), tracking_hash) : SvLEN(thing);
+#else
     total_size += SvLEN(thing);
+#endif
     break;
   case SVt_PVMG:
     total_size += sizeof(XPVMG);
+#if (PERL_VERSION < 11)
+    total_size += SvROK(thing) ? thing_size( SvRV(thing), tracking_hash) : SvLEN(thing);
+#else
     total_size += SvLEN(thing);
+#endif
     total_size += magic_size(thing, tracking_hash);
     break;
+#if PERL_VERSION <= 8
   case SVt_PVBM:
     total_size += sizeof(XPVBM);
+#if (PERL_VERSION < 11)
+    total_size += SvROK(thing) ? thing_size( SvRV(thing), tracking_hash) : SvLEN(thing);
+#else
     total_size += SvLEN(thing);
+#endif
     total_size += magic_size(thing, tracking_hash);
     break;
+#endif
   case SVt_PVLV:
     total_size += sizeof(XPVLV);
+#if (PERL_VERSION < 11)
+    total_size += SvROK(thing) ? thing_size( SvRV(thing), tracking_hash) : SvLEN(thing);
+#else
     total_size += SvLEN(thing);
+#endif
     total_size += magic_size(thing, tracking_hash);
     break;
     /* How much space is dedicated to the array? Not counting the
@@ -125,10 +475,20 @@ UV thing_size(SV *orig_thing, HV *tracking_hash) {
     total_size += sizeof(XPVAV);
     /* Is there anything in the array? */
     if (AvMAX(thing) != -1) {
-      total_size += sizeof(SV *) * AvMAX(thing);
+      /* an array with 10 slots has AvMax() set to 9 - te 2007-04-22 */
+      total_size += sizeof(SV *) * (AvMAX(thing) + 1);
+      dbg_printf(("total_size: %li AvMAX: %li av_len: $i\n", total_size, AvMAX(thing), av_len((AV*)thing)));
     }
     /* Add in the bits on the other side of the beginning */
-    total_size += (sizeof(SV *) * (AvARRAY(thing) - AvALLOC(thing)));
+
+    dbg_printf(("total_size %li, sizeof(SV *) %li, AvARRAY(thing) %li, AvALLOC(thing)%li , sizeof(ptr) %li \n", 
+	total_size, sizeof(SV*), AvARRAY(thing), AvALLOC(thing), sizeof( thing )));
+
+    /* under Perl 5.8.8 64bit threading, AvARRAY(thing) was a pointer while AvALLOC was 0,
+       resulting in grossly overstated sized for arrays. Technically, this shouldn't happen... */
+    if (AvALLOC(thing) != 0) {
+      total_size += (sizeof(SV *) * (AvARRAY(thing) - AvALLOC(thing)));
+      }
     /* Is there something hanging off the arylen element? */
     if (AvARYLEN(thing)) {
       if (check_new(tracking_hash, AvARYLEN(thing))) {
@@ -165,35 +525,128 @@ UV thing_size(SV *orig_thing, HV *tracking_hash) {
   case SVt_PVCV:
     total_size += sizeof(XPVCV);
     total_size += magic_size(thing, tracking_hash);
-    carp("CV isn't complete");
+
+    total_size += ((XPVIO *) SvANY(thing))->xpv_len;
+    if (check_new(tracking_hash, CvSTASH(thing))) {
+      total_size += thing_size((SV *)CvSTASH(thing), tracking_hash);
+    }
+    if (check_new(tracking_hash, SvSTASH(thing))) {
+      total_size += thing_size((SV *)SvSTASH(thing), tracking_hash);
+    }
+    if (check_new(tracking_hash, CvGV(thing))) {
+      total_size += thing_size((SV *)CvGV(thing), tracking_hash);
+    }
+    if (check_new(tracking_hash, CvPADLIST(thing))) {
+      total_size += thing_size((SV *)CvPADLIST(thing), tracking_hash);
+    }
+    if (check_new(tracking_hash, CvOUTSIDE(thing))) {
+      total_size += thing_size((SV *)CvOUTSIDE(thing), tracking_hash);
+    }
+
+    if (check_new(tracking_hash, CvSTART(thing))) {
+      total_size += op_size(CvSTART(thing), tracking_hash);
+    }
+    if (check_new(tracking_hash, CvROOT(thing))) {
+      total_size += op_size(CvROOT(thing), tracking_hash);
+    }
+
     break;
   case SVt_PVGV:
     total_size += magic_size(thing, tracking_hash);
     total_size += sizeof(XPVGV);
     total_size += GvNAMELEN(thing);
+#ifdef GvFILE
     /* Is there a file? */
     if (GvFILE(thing)) {
       if (check_new(tracking_hash, GvFILE(thing))) {
 	total_size += strlen(GvFILE(thing));
       }
     }
+#endif
     /* Is there something hanging off the glob? */
     if (GvGP(thing)) {
       if (check_new(tracking_hash, GvGP(thing))) {
 	total_size += sizeof(GP);
+	{
+	  SV *generic_thing;
+	  if ((generic_thing = (SV *)(GvGP(thing)->gp_sv))) {
+	    total_size += thing_size(generic_thing, tracking_hash);
+	  }
+	  if ((generic_thing = (SV *)(GvGP(thing)->gp_form))) {
+	    total_size += thing_size(generic_thing, tracking_hash);
+	  }
+	  if ((generic_thing = (SV *)(GvGP(thing)->gp_av))) {
+	    total_size += thing_size(generic_thing, tracking_hash);
+	  }
+	  if ((generic_thing = (SV *)(GvGP(thing)->gp_hv))) {
+	    total_size += thing_size(generic_thing, tracking_hash);
+	  }
+	  if ((generic_thing = (SV *)(GvGP(thing)->gp_egv))) {
+	    total_size += thing_size(generic_thing, tracking_hash);
+	  }
+	  if ((generic_thing = (SV *)(GvGP(thing)->gp_cv))) {
+	    total_size += thing_size(generic_thing, tracking_hash);
+	  }
+	}
       }
     }
     break;
   case SVt_PVFM:
     total_size += sizeof(XPVFM);
-    carp("FM isn't complete");
+    total_size += magic_size(thing, tracking_hash);
+    total_size += ((XPVIO *) SvANY(thing))->xpv_len;
+    if (check_new(tracking_hash, CvPADLIST(thing))) {
+      total_size += thing_size((SV *)CvPADLIST(thing), tracking_hash);
+    }
+    if (check_new(tracking_hash, CvOUTSIDE(thing))) {
+      total_size += thing_size((SV *)CvOUTSIDE(thing), tracking_hash);
+    }
+
+    if (go_yell && !fm_whine) {
+      carp("Devel::Size: Calculated sizes for FMs are incomplete");
+      fm_whine = 1;
+    }
     break;
   case SVt_PVIO:
     total_size += sizeof(XPVIO);
-    carp("IO isn't complete");
+    total_size += magic_size(thing, tracking_hash);
+    if (check_new(tracking_hash, (SvPVX(thing)))) {
+      total_size += ((XPVIO *) SvANY(thing))->xpv_cur;
+    }
+    /* Some embedded char pointers */
+    if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xio_top_name)) {
+      total_size += strlen(((XPVIO *) SvANY(thing))->xio_top_name);
+    }
+    if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xio_fmt_name)) {
+      total_size += strlen(((XPVIO *) SvANY(thing))->xio_fmt_name);
+    }
+    if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xio_bottom_name)) {
+      total_size += strlen(((XPVIO *) SvANY(thing))->xio_bottom_name);
+    }
+    /* Throw the GVs on the list to be walked if they're not-null */
+    if (((XPVIO *) SvANY(thing))->xio_top_gv) {
+      total_size += thing_size((SV *)((XPVIO *) SvANY(thing))->xio_top_gv, 
+			       tracking_hash);
+    }
+    if (((XPVIO *) SvANY(thing))->xio_bottom_gv) {
+      total_size += thing_size((SV *)((XPVIO *) SvANY(thing))->xio_bottom_gv, 
+			       tracking_hash);
+    }
+    if (((XPVIO *) SvANY(thing))->xio_fmt_gv) {
+      total_size += thing_size((SV *)((XPVIO *) SvANY(thing))->xio_fmt_gv, 
+			       tracking_hash);
+    }
+
+    /* Only go trotting through the IO structures if they're really
+       trottable. If USE_PERLIO is defined we can do this. If
+       not... we can't, so we don't even try */
+#ifdef USE_PERLIO
+    /* Dig into xio_ifp and xio_ofp here */
+    croak("Devel::Size: Can't size up perlio layers yet");
+#endif
     break;
   default:
-    croak("Unknown variable type");
+    croak("Devel::Size: Unknown variable type");
   }
   return total_size;
 }
@@ -210,13 +663,29 @@ CODE:
   SV *thing = orig_thing;
   /* Hash to track our seen pointers */
   HV *tracking_hash = newHV();
+  SV *warn_flag;
 
+  /* Check warning status */
+  go_yell = 0;
+  regex_whine = 0;
+  fm_whine = 0;
+
+  if (NULL != (warn_flag = perl_get_sv("Devel::Size::warn", FALSE))) {
+    go_yell = SvIV(warn_flag);
+  }
+  
   /* If they passed us a reference then dereference it. This is the
      only way we can check the sizes of arrays and hashes */
+#if (PERL_VERSION < 11)
   if (SvOK(thing) && SvROK(thing)) {
     thing = SvRV(thing);
   }
-  
+#else
+  if (SvROK(thing)) {
+    thing = SvRV(thing);
+  }
+#endif
+
   RETVAL = thing_size(thing, tracking_hash);
   /* Clean up after ourselves */
   SvREFCNT_dec(tracking_hash);
@@ -232,21 +701,36 @@ CODE:
 {
   SV *thing = orig_thing;
   /* Hash to track our seen pointers */
-  HV *tracking_hash = newHV();
-  AV *pending_array = newAV();
+  HV *tracking_hash;
+  /* Array with things we still need to do */
+  AV *pending_array;
   IV size = 0;
-
-  IV count = 0;
+  SV *warn_flag;
 
   /* Size starts at zero */
   RETVAL = 0;
 
-  /* If they passed us a reference then dereference it. This is the
-     only way we can check the sizes of arrays and hashes */
-  if (SvOK(thing) && SvROK(thing)) {
-    thing = SvRV(thing);
+  /* Check warning status */
+  go_yell = 0;
+  regex_whine = 0;
+  fm_whine = 0;
+
+  if (NULL != (warn_flag = perl_get_sv("Devel::Size::warn", FALSE))) {
+    go_yell = SvIV(warn_flag);
   }
 
+  /* init these after the go_yell above */
+  tracking_hash = newHV();
+  pending_array = newAV();
+
+  /* We cannot push HV/AV directly, only the RV. So deref it
+     later (see below for "*** dereference later") and adjust here for
+     the miscalculation.
+     This is the only way we can check the sizes of arrays and hashes. */
+  if (SvROK(thing)) {
+      RETVAL -= thing_size(thing, NULL);
+  } 
+
   /* Put it on the pending array */
   av_push(pending_array, thing);
 
@@ -255,16 +739,35 @@ CODE:
     thing = av_pop(pending_array);
     /* Process it if we've not seen it */
     if (check_new(tracking_hash, thing)) {
+      dbg_printf(("# Found type %i at %p\n", SvTYPE(thing), thing));
       /* Is it valid? */
       if (thing) {
 	/* Yes, it is. So let's check the type */
 	switch (SvTYPE(thing)) {
-	case SVt_RV:
-	  av_push(pending_array, SvRV(thing));
+	/* fix for bug #24846 (Does not correctly recurse into references in a PVNV-type scalar) */
+	case SVt_PVNV:
+	  if (SvROK(thing))
+	    {
+	    av_push(pending_array, SvRV(thing));
+	    } 
 	  break;
 
+	/* this is the "*** dereference later" part - see above */
+#if (PERL_VERSION < 11)
+        case SVt_RV:
+#else
+        case SVt_IV:
+#endif
+             dbg_printf(("# Found RV\n"));
+          if (SvROK(thing)) {
+             dbg_printf(("# Found RV\n"));
+             av_push(pending_array, SvRV(thing));
+          }
+          break;
+
 	case SVt_PVAV:
 	  {
+	    dbg_printf(("# Found type AV\n"));
 	    /* Quick alias to cut down on casting */
 	    AV *tempAV = (AV *)thing;
 	    SV **tempSV;
@@ -275,7 +778,7 @@ CODE:
 	      /* Run through them all */
 	      for (index = 0; index <= av_len(tempAV); index++) {
 		/* Did we get something? */
-		if (tempSV = av_fetch(tempAV, index, 0)) {
+		if ((tempSV = av_fetch(tempAV, index, 0))) {
 		  /* Was it undef? */
 		  if (*tempSV != &PL_sv_undef) {
 		    /* Apparently not. Save it for later */
@@ -288,16 +791,18 @@ CODE:
 	  break;
 
 	case SVt_PVHV:
+	  dbg_printf(("# Found type HV\n"));
 	  /* Is there anything in here? */
 	  if (hv_iterinit((HV *)thing)) {
 	    HE *temp_he;
-	    while (temp_he = hv_iternext((HV *)thing)) {
+	    while ((temp_he = hv_iternext((HV *)thing))) {
 	      av_push(pending_array, hv_iterval((HV *)thing, temp_he));
 	    }
 	  }
 	  break;
 	 
 	case SVt_PVGV:
+	  dbg_printf(("# Found type GV\n"));
 	  /* Run through all the pieces and push the ones with bits */
 	  if (GvSV(thing)) {
 	    av_push(pending_array, (SV *)GvSV(thing));
@@ -323,12 +828,16 @@ CODE:
       
       size = thing_size(thing, tracking_hash);
       RETVAL += size;
-      //      printf("added thing of size %i, thing #%i\n", size, count++);
+    } else {
+    /* check_new() returned false: */
+#ifdef DEVEL_SIZE_DEBUGGING
+       if (SvOK(sv)) printf("# Ignore ref copy 0x%x\n", sv);
+       else printf("# Ignore non-sv 0x%x\n", sv);
+#endif
     }
-  }
+  } /* end while */
   
   /* Clean up after ourselves */
-  //  printf("For info, refcounts are %i, %i\n", SvREFCNT(tracking_hash), SvREFCNT(pending_array));
   SvREFCNT_dec(tracking_hash);
   SvREFCNT_dec(pending_array);
 }