projects / p5sagit/Devel-Size.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw
Fix COPHH for PERL_BCDVERSION < 0x5013007
[p5sagit/Devel-Size.git] / SizeMe.xs
diff --git a/SizeMe.xs b/SizeMe.xs
index 398e139..ddef672 100644 (file)
--- a/SizeMe.xs
+++ b/SizeMe.xs
@@ -43,6 +43,12 @@
 #  define SvSHARED_HEK_FROM_PV(pvx) \
         ((struct hek*)(pvx - STRUCT_OFFSET(struct hek, hek_key)))
 #endif
+#ifndef MUTABLE_AV
+#define MUTABLE_AV(p) ((AV*)p)
+#endif
+#ifndef MUTABLE_SV
+#define MUTABLE_SV(p) ((SV*)p)
+#endif
 
 #if PERL_VERSION < 6
 #  define PL_opargs opargs
@@ -781,6 +787,7 @@ hek_size(pTHX_ struct state *st, HEK *hek, U32 shared, pPATH)
     return 1;
 }
 
+#if (PERL_BCDVERSION >= 0x5009004)
 static void
 refcounted_he_size(pTHX_ struct state *st, struct refcounted_he *he, pPATH)
 {
@@ -799,6 +806,7 @@ refcounted_he_size(pTHX_ struct state *st, struct refcounted_he *he, pPATH)
   if (he->refcounted_he_next)
     refcounted_he_size(aTHX_ st, he->refcounted_he_next, NPathLink("refcounted_he_next"));
 }
+#endif
 
 static void op_size_class(pTHX_ const OP * const baseop, opclass op_class, bool skip_op_struct, struct state *st, pPATH);
 
@@ -919,7 +927,6 @@ op_size_class(pTHX_ const OP * const baseop, opclass op_class, bool skip_op_stru
        case OPc_COP: TAG;
         {
           COP *basecop;
-         COPHH *hh;
           basecop = (COP *)baseop;
          if (!skip_op_struct)
            ADD_SIZE(st, "cop", sizeof(struct cop));
@@ -936,15 +943,22 @@ op_size_class(pTHX_ const OP * const baseop, opclass op_class, bool skip_op_stru
 #endif
 #ifdef USE_ITHREADS
           check_new_and_strlen(st, basecop->cop_file, NPathLink("cop_file"));
-          check_new_and_strlen(st, basecop->cop_stashpv, NPathLink("cop_stashpv"));
+          /*check_new_and_strlen(st, basecop->cop_stashpv, NPathLink("cop_stashpv"));  XXX */
 #else
           if (SvREFCNT(basecop->cop_stash) == 1) /* XXX hack? */
             sv_size(aTHX_ st, NPathLink("cop_stash"), (SV *)basecop->cop_stash, SOME_RECURSION);
          sv_size(aTHX_ st, NPathLink("cop_filegv"), (SV *)basecop->cop_filegv, SOME_RECURSION);
 #endif
 
-         hh = CopHINTHASH_get(basecop);
-         refcounted_he_size(aTHX_ st, hh, NPathLink("cop_hints_hash"));
+#if (PERL_BCDVERSION >= 0x5009004)
+#  if (PERL_BCDVERSION < 0x5013007)
+#    define COPHH struct refcounted_he
+#  endif
+#  ifndef CopHINTHASH_get
+#    define CopHINTHASH_get(c)  ((COPHH*)((c)->cop_hints_hash))
+#  endif
+         refcounted_he_size(aTHX_ st, CopHINTHASH_get(basecop), NPathLink("cop_hints_hash"));
+#endif
         }
         TAG;break;
       default:
@@ -1309,7 +1323,11 @@ else warn("skipped suspect HeVAL %p", HeVAL(cur_entry));
 #ifdef GvFILE_HEK
        hek_size(aTHX_ st, GvFILE_HEK(thing), 1, NPathLink("GvFILE_HEK"));
 #elif defined(GvFILE)
-#  if !defined(USE_ITHREADS) || (PERL_VERSION > 8 || (PERL_VERSION == 8 && PERL_SUBVERSION > 8))
+/* XXX this coredumped for me in t/recurse.t with a non-threaded 5.8.9
+ * so I've changed the condition to be more restricive
+ *#  if !defined(USE_ITHREADS) || (PERL_VERSION > 8 || (PERL_VERSION == 8 && PERL_SUBVERSION > 8))
+ */
+#  if (PERL_VERSION > 8 || (PERL_VERSION == 8 && PERL_SUBVERSION > 9))
        /* 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.
@@ -1361,7 +1379,8 @@ else warn("skipped suspect HeVAL %p", HeVAL(cur_entry));
   if (type >= SVt_PVMG) {
     if (SvMAGICAL(thing))
       magic_size(aTHX_ thing, st, NPathLink("MG"));
-    if (SvPAD_OUR(thing) && SvOURSTASH(thing))
+    /* SVpad_OUR shares same flag bit as SVpbm_VALID and others */
+    if (type == SVt_PVGV && SvPAD_OUR(thing) && SvOURSTASH(thing))
       sv_size(aTHX_ st, NPathLink("SvOURSTASH"), (SV *)SvOURSTASH(thing), SOME_RECURSION);
     if (SvSTASH(thing))
       sv_size(aTHX_ st, NPathLink("SvSTASH"), (SV *)SvSTASH(thing), SOME_RECURSION);
@@ -1484,6 +1503,7 @@ madprop_size(pTHX_ struct state *const st, pPath, MADPROP *prop)
 }
 #endif
 
+#if (PERL_BCDVERSION >= 0x5009005)
 static void
 parser_size(pTHX_ struct state *const st, pPATH, yy_parser *parser)
 {
@@ -1499,8 +1519,13 @@ parser_size(pTHX_ struct state *const st, pPATH, yy_parser *parser)
   /*warn("foo: %u", parser->ps - parser->stack); */
   ADD_SIZE(st, "stack_frames", parser->stack_size * sizeof(yy_stack_frame));
   for (ps = parser->stack; ps <= parser->ps; ps++) {
+#if (PERL_BCDVERSION >= 0x5011001) /* roughly */
     if (sv_size(aTHX_ st, NPathLink("compcv"), (SV*)ps->compcv, TOTAL_SIZE_RECURSION))
         ADD_LINK_ATTR(st, NPattr_NOTE, "i", ps - parser->ps);
+#else /* prior to perl 8c63ea58  Dec 8 2009 */
+    if (sv_size(aTHX_ st, NPathLink("comppad"), (SV*)ps->comppad, TOTAL_SIZE_RECURSION))
+        ADD_LINK_ATTR(st, NPattr_NOTE, "i", ps - parser->ps);
+#endif
   }
   NPathPopNode;
 
@@ -1527,6 +1552,7 @@ parser_size(pTHX_ struct state *const st, pPATH, yy_parser *parser)
   if (parser->old_parser)
     parser_size(aTHX_ st, NPathLink("old_parser"), parser->old_parser);
 }
+#endif
 
 static void
 perl_size(pTHX_ struct state *const st, pPATH)
@@ -1556,8 +1582,12 @@ perl_size(pTHX_ struct state *const st, pPATH)
   sv_size(aTHX_ st, NPathLink("PL_errors"), (SV*)PL_errors, TOTAL_SIZE_RECURSION);
   sv_size(aTHX_ st, NPathLink("PL_stashcache"), (SV*)PL_stashcache, TOTAL_SIZE_RECURSION);
   sv_size(aTHX_ st, NPathLink("PL_patchlevel"), (SV*)PL_patchlevel, TOTAL_SIZE_RECURSION);
+#ifdef PL_apiversion
   sv_size(aTHX_ st, NPathLink("PL_apiversion"), (SV*)PL_apiversion, TOTAL_SIZE_RECURSION);
+#endif
+#ifdef PL_registered_mros
   sv_size(aTHX_ st, NPathLink("PL_registered_mros"), (SV*)PL_registered_mros, TOTAL_SIZE_RECURSION);
+#endif
 #ifdef USE_ITHREADS
   sv_size(aTHX_ st, NPathLink("PL_regex_padav"), (SV*)PL_regex_padav, TOTAL_SIZE_RECURSION);
 #endif
@@ -1571,24 +1601,34 @@ perl_size(pTHX_ struct state *const st, pPATH)
   sv_size(aTHX_ st, NPathLink("PL_hintgv"), (SV*)PL_hintgv, TOTAL_SIZE_RECURSION);
   sv_size(aTHX_ st, NPathLink("PL_e_script"), (SV*)PL_e_script, TOTAL_SIZE_RECURSION);
   sv_size(aTHX_ st, NPathLink("PL_encoding"), (SV*)PL_encoding, TOTAL_SIZE_RECURSION);
+#ifdef PL_ofsgv
   sv_size(aTHX_ st, NPathLink("PL_ofsgv"), (SV*)PL_ofsgv, TOTAL_SIZE_RECURSION);
+#endif
   sv_size(aTHX_ st, NPathLink("PL_argvout_stack"), (SV*)PL_argvout_stack, TOTAL_SIZE_RECURSION);
   sv_size(aTHX_ st, NPathLink("PL_beginav"), (SV*)PL_beginav, TOTAL_SIZE_RECURSION);
   sv_size(aTHX_ st, NPathLink("PL_beginav_save"), (SV*)PL_beginav_save, TOTAL_SIZE_RECURSION);
   sv_size(aTHX_ st, NPathLink("PL_checkav_save"), (SV*)PL_checkav_save, TOTAL_SIZE_RECURSION);
+#ifdef PL_unitcheckav
   sv_size(aTHX_ st, NPathLink("PL_unitcheckav"), (SV*)PL_unitcheckav, TOTAL_SIZE_RECURSION);
+#endif
+#ifdef PL_unitcheckav_save
   sv_size(aTHX_ st, NPathLink("PL_unitcheckav_save"), (SV*)PL_unitcheckav_save, TOTAL_SIZE_RECURSION);
+#endif
   sv_size(aTHX_ st, NPathLink("PL_endav"), (SV*)PL_endav, TOTAL_SIZE_RECURSION);
   sv_size(aTHX_ st, NPathLink("PL_checkav"), (SV*)PL_checkav, TOTAL_SIZE_RECURSION);
   sv_size(aTHX_ st, NPathLink("PL_initav"), (SV*)PL_initav, TOTAL_SIZE_RECURSION);
+#ifdef PL_isarev
   sv_size(aTHX_ st, NPathLink("PL_isarev"), (SV*)PL_isarev, TOTAL_SIZE_RECURSION);
+#endif
   sv_size(aTHX_ st, NPathLink("PL_fdpid"), (SV*)PL_fdpid, TOTAL_SIZE_RECURSION);
   sv_size(aTHX_ st, NPathLink("PL_preambleav"), (SV*)PL_preambleav, TOTAL_SIZE_RECURSION);
   sv_size(aTHX_ st, NPathLink("PL_ors_sv"), (SV*)PL_ors_sv, TOTAL_SIZE_RECURSION);
   sv_size(aTHX_ st, NPathLink("PL_modglobal"), (SV*)PL_modglobal, TOTAL_SIZE_RECURSION);
   sv_size(aTHX_ st, NPathLink("PL_custom_op_names"), (SV*)PL_custom_op_names, TOTAL_SIZE_RECURSION);
   sv_size(aTHX_ st, NPathLink("PL_custom_op_descs"), (SV*)PL_custom_op_descs, TOTAL_SIZE_RECURSION);
+#ifdef PL_custom_ops
   sv_size(aTHX_ st, NPathLink("PL_custom_ops"), (SV*)PL_custom_ops, TOTAL_SIZE_RECURSION);
+#endif
   sv_size(aTHX_ st, NPathLink("PL_compcv"), (SV*)PL_compcv, TOTAL_SIZE_RECURSION);
   sv_size(aTHX_ st, NPathLink("PL_DBcv"), (SV*)PL_DBcv, TOTAL_SIZE_RECURSION);
 #ifdef PERL_USES_PL_PIDSTATUS
@@ -1622,7 +1662,10 @@ perl_size(pTHX_ struct state *const st, pPATH)
   op_size_class(aTHX_ (OP*)&PL_compiling, OPc_COP, 1, st, NPathLink("PL_compiling"));
   op_size_class(aTHX_ (OP*)PL_curcopdb, OPc_COP, 0, st, NPathLink("PL_curcopdb"));
 
+#if (PERL_BCDVERSION >= 0x5009005)
   parser_size(aTHX_ st, NPathLink("PL_parser"), PL_parser);
+#endif
+
   /* TODO stacks: cur, main, tmps, mark, scope, save */
   /* TODO PL_exitlist */
   /* TODO PL_reentrant_buffers etc */
Unnamed repository; edit this file 'description' to name the repository.