X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=Size.xs;h=14be0be10aebb2a363a0dc8538d4dc9e49b8a41a;hb=901d4b6c755efa5f11f7e57fab9da76e39efce3b;hp=9a5452231fddbcef185d95fc3af977c30b01ef35;hpb=f76b99c2b19270e6e362a45b305cc58a69a2eb48;p=p5sagit%2FDevel-Size.git

diff --git a/Size.xs b/Size.xs
index 9a54522..14be0be 100644
--- a/Size.xs
+++ b/Size.xs
@@ -46,7 +46,6 @@
    without excessive memory needs. The assumption is that your CPU cache
    works :-) (And that we're not going to bust it)  */
 
-#define ALIGN_BITS  ( sizeof(void*) >> 1 )
 #define BYTE_BITS    3
 #define LEAF_BITS   (16 - BYTE_BITS)
 #define LEAF_MASK   0x1FFF
@@ -78,7 +77,7 @@ check_new(struct state *st, const void *const p) {
        (and hence hot in the cache) but we can still deal with any unaligned
        pointers.  */
     const size_t cooked_p
-	= (raw_p >> ALIGN_BITS) | (raw_p << (bits - BYTE_BITS));
+	= (raw_p >> ALIGN_BITS) | (raw_p << (bits - ALIGN_BITS));
     const U8 this_bit = 1 << (cooked_p & 0x7);
     U8 **leaf_p;
     U8 *leaf;
@@ -312,19 +311,10 @@ cc_opclass(const OP * const o)
 /* Figure out how much magic is attached to the SV and return the
    size */
 static void
-magic_size(const SV * const thing, struct state *st) {
-  MAGIC *magic_pointer;
+magic_size(pTHX_ const SV * const thing, struct state *st) {
+  MAGIC *magic_pointer = SvMAGIC(thing);
 
-  /* Is there any? */
-  if (!SvMAGIC(thing)) {
-    /* No, bail */
-    return;
-  }
-
-  /* Get the base magic pointer */
-  magic_pointer = SvMAGIC(thing);
-
-  /* Have we seen the magic pointer? */
+  /* Have we seen the magic pointer?  (NULL has always been seen before)  */
   while (check_new(st, magic_pointer)) {
     st->total_size += sizeof(MAGIC);
 
@@ -333,6 +323,22 @@ magic_size(const SV * const thing, struct state *st) {
         if (check_new(st, magic_pointer->mg_virtual)) {
           st->total_size += sizeof(MGVTBL);
         }
+	sv_size(aTHX_ st, magic_pointer->mg_obj, TOTAL_SIZE_RECURSION);
+	if (magic_pointer->mg_len == HEf_SVKEY) {
+	    sv_size(aTHX_ st, (SV *)magic_pointer->mg_ptr, TOTAL_SIZE_RECURSION);
+	}
+#if defined(PERL_MAGIC_utf8) && defined (PERL_MAGIC_UTF8_CACHESIZE)
+	else if (magic_pointer->mg_type == PERL_MAGIC_utf8) {
+	    if (check_new(st, magic_pointer->mg_ptr)) {
+		st->total_size += PERL_MAGIC_UTF8_CACHESIZE * 2 * sizeof(STRLEN);
+	    }
+	}
+#endif
+	else if (magic_pointer->mg_len > 0) {
+	    if (check_new(st, magic_pointer->mg_ptr)) {
+		st->total_size += magic_pointer->mg_len;
+	    }
+	}
 
         /* Get the next in the chain */
         magic_pointer = magic_pointer->mg_moremagic;
@@ -561,7 +567,7 @@ sv_size(pTHX_ struct state *const st, const SV * const orig_thing,
 	sv_size(aTHX_ st, SvRV_const(thing), recurse);
     else
 	st->total_size += SvLEN(thing);
-    magic_size(thing, st);
+    magic_size(aTHX_ thing, st);
     TAG;break;
 #if PERL_VERSION <= 8
   case SVt_PVBM: TAG;
@@ -570,7 +576,7 @@ sv_size(pTHX_ struct state *const st, const SV * const orig_thing,
 	sv_size(aTHX_ st, SvRV_const(thing), recurse);
     else
 	st->total_size += SvLEN(thing);
-    magic_size(thing, st);
+    magic_size(aTHX_ thing, st);
     TAG;break;
 #endif
   case SVt_PVLV: TAG;
@@ -579,7 +585,7 @@ sv_size(pTHX_ struct state *const st, const SV * const orig_thing,
 	sv_size(aTHX_ st, SvRV_const(thing), recurse);
     else
 	st->total_size += SvLEN(thing);
-    magic_size(thing, st);
+    magic_size(aTHX_ thing, st);
     TAG;break;
     /* How much space is dedicated to the array? Not counting the
        elements in the array, mind, just the array itself */
@@ -615,7 +621,7 @@ sv_size(pTHX_ struct state *const st, const SV * const orig_thing,
        complain about AvARYLEN() passing thing to it.  */
     sv_size(aTHX_ st, AvARYLEN(thing), recurse);
 #endif
-    magic_size(thing, st);
+    magic_size(aTHX_ thing, st);
     TAG;break;
   case SVt_PVHV: TAG;
     /* First the base struct */
@@ -642,11 +648,11 @@ sv_size(pTHX_ struct state *const st, const SV * const orig_thing,
         }
       }
     }
-    magic_size(thing, st);
+    magic_size(aTHX_ thing, st);
     TAG;break;
   case SVt_PVCV: TAG;
     st->total_size += sizeof(XPVCV);
-    magic_size(thing, st);
+    magic_size(aTHX_ thing, st);
 
     st->total_size += ((XPVIO *) SvANY(thing))->xpv_len;
     sv_size(aTHX_ st, (SV *)CvSTASH(thing), SOME_RECURSION);
@@ -663,13 +669,21 @@ sv_size(pTHX_ struct state *const st, const SV * const orig_thing,
 
     TAG;break;
   case SVt_PVGV: TAG;
-    magic_size(thing, st);
+    magic_size(aTHX_ thing, st);
     st->total_size += sizeof(XPVGV);
     if(isGV_with_GP(thing)) {
 	st->total_size += GvNAMELEN(thing);
 #ifdef GvFILE
-	/* Is there a file? */
+#  if !defined(USE_ITHREADS) || (PERL_VERSION > 8 || (PERL_VERSION == 8 && PERL_SUBVERSION > 8))
+	/* With itreads, before 5.8.9, this can end up pointing to freed memory
+	   if the GV was created in an eval, as GvFILE() points to CopFILE(),
+	   and the relevant COP has been freed on scope cleanup after the eval.
+	   5.8.9 adds a binary compatible fudge that catches the vast majority
+	   of cases. 5.9.something added a proper fix, by converting the GP to
+	   use a shared hash key (porperly reference counted), instead of a
+	   char * (owned by who knows? possibly no-one now) */
 	check_new_and_strlen(st, GvFILE(thing));
+#  endif
 #endif
 	/* Is there something hanging off the glob? */
 	if (check_new(st, GvGP(thing))) {
@@ -685,7 +699,7 @@ sv_size(pTHX_ struct state *const st, const SV * const orig_thing,
     TAG;break;
   case SVt_PVFM: TAG;
     st->total_size += sizeof(XPVFM);
-    magic_size(thing, st);
+    magic_size(aTHX_ thing, st);
     st->total_size += ((XPVIO *) SvANY(thing))->xpv_len;
     sv_size(aTHX_ st, (SV *)CvPADLIST(thing), SOME_RECURSION);
     sv_size(aTHX_ st, (SV *)CvOUTSIDE(thing), recurse);
@@ -697,7 +711,7 @@ sv_size(pTHX_ struct state *const st, const SV * const orig_thing,
     TAG;break;
   case SVt_PVIO: TAG;
     st->total_size += sizeof(XPVIO);
-    magic_size(thing, st);
+    magic_size(aTHX_ thing, st);
     if (check_new(st, (SvPVX_const(thing)))) {
       st->total_size += ((XPVIO *) SvANY(thing))->xpv_cur;
     }
@@ -724,11 +738,28 @@ sv_size(pTHX_ struct state *const st, const SV * const orig_thing,
   return TRUE;
 }
 
+/* Frustratingly, the vtables aren't const in perl.h
+   gcc is happy enough to have non-const initialisers in a static array.
+   VC seems not to be. (Is it actually treating the file as C++?)
+   So do the maximally portable thing, unless we know it's gcc, in which case
+   we can do the more space efficient version.  */
+
+#if __GNUC__
+void *vtables[] = {
+#include "vtables.inc"
+    NULL
+};
+#endif
+
 static struct state *
 new_state(pTHX)
 {
     SV *warn_flag;
     struct state *st;
+#if __GNUC__
+    void **vt_p = vtables;
+#endif
+
     Newxz(st, 1, struct state);
     st->go_yell = TRUE;
     if (NULL != (warn_flag = perl_get_sv("Devel::Size::warn", FALSE))) {
@@ -740,6 +771,12 @@ new_state(pTHX)
     check_new(st, &PL_sv_undef);
     check_new(st, &PL_sv_no);
     check_new(st, &PL_sv_yes);
+#if __GNUC__
+    while(*vt_p)
+	check_new(st, *vt_p++);
+#else
+#include "vtables.inc"
+#endif
     return st;
 }