Rework constant.pm to take advantage of the space savings of proxy
[p5sagit/p5-mst-13.2.git] / dump.c
diff --git a/dump.c b/dump.c
index 9448df0..0679ed9 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -24,6 +24,8 @@
 #define PERL_IN_DUMP_C
 #include "perl.h"
 #include "regcomp.h"
+#include "proto.h"
+
 
 #define Sequence PL_op_sequence
 
@@ -154,7 +156,7 @@ char *
 Perl_sv_peek(pTHX_ SV *sv)
 {
     dVAR;
-    SV *t = sv_newmortal();
+    SV * const t = sv_newmortal();
     int unref = 0;
 
     sv_setpvn(t, "", 0);
@@ -402,22 +404,20 @@ Perl_pmop_dump(pTHX_ PMOP *pm)
 /* An op sequencer.  We visit the ops in the order they're to execute. */
 
 STATIC void
-sequence(pTHX_ register const OP *o)
+S_sequence(pTHX_ register const OP *o)
 {
     dVAR;
     SV      *op;
     const char *key;
     STRLEN   len;
-    const OP *oldop = 0;
+    const OP *oldop = NULL;
     OP      *l;
 
     if (!o)
        return;
 
-    op = newSVuv(PTR2UV(o));
-    key = SvPV_const(op, len);
-    if (hv_exists(Sequence, key, len))
-       return;
+    if (!Sequence)
+       Sequence = newHV();
 
     for (; o; o = o->op_next) {
        op = newSVuv(PTR2UV(o));
@@ -458,7 +458,7 @@ sequence(pTHX_ register const OP *o)
            hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
            for (l = cLOGOPo->op_other; l && l->op_type == OP_NULL; l = l->op_next)
                ;
-           sequence(aTHX_ l);
+           sequence(l);
            break;
 
        case OP_ENTERLOOP:
@@ -466,13 +466,13 @@ sequence(pTHX_ register const OP *o)
            hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
            for (l = cLOOPo->op_redoop; l && l->op_type == OP_NULL; l = l->op_next)
                ;
-           sequence(aTHX_ l);
+           sequence(l);
            for (l = cLOOPo->op_nextop; l && l->op_type == OP_NULL; l = l->op_next)
                ;
-           sequence(aTHX_ l);
+           sequence(l);
            for (l = cLOOPo->op_lastop; l && l->op_type == OP_NULL; l = l->op_next)
                ;
-           sequence(aTHX_ l);
+           sequence(l);
            break;
 
        case OP_QR:
@@ -481,7 +481,7 @@ sequence(pTHX_ register const OP *o)
            hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
            for (l = cPMOPo->op_pmreplstart; l && l->op_type == OP_NULL; l = l->op_next)
                ;
-           sequence(aTHX_ l);
+           sequence(l);
            break;
 
        case OP_HELEM:
@@ -496,7 +496,7 @@ sequence(pTHX_ register const OP *o)
 }
 
 STATIC UV
-sequence_num(pTHX_ const OP *o)
+S_sequence_num(pTHX_ const OP *o)
 {
     dVAR;
     SV     *op,
@@ -515,10 +515,10 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
 {
     dVAR;
     UV      seq;
-    sequence(aTHX_ o);
+    sequence(o);
     Perl_dump_indent(aTHX_ level, file, "{\n");
     level++;
-    seq = sequence_num(aTHX_ o);
+    seq = sequence_num(o);
     if (seq)
        PerlIO_printf(file, "%-4"UVf, seq);
     else
@@ -528,7 +528,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
                  (int)(PL_dumpindent*level-4), "", OP_NAME(o));
     if (o->op_next)
        PerlIO_printf(file, seq ? "%"UVf"\n" : "(%"UVf")\n",
-                               sequence_num(aTHX_ o->op_next));
+                               sequence_num(o->op_next));
     else
        PerlIO_printf(file, "DONE\n");
     if (o->op_targ) {
@@ -802,17 +802,17 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
     case OP_ENTERLOOP:
        Perl_dump_indent(aTHX_ level, file, "REDO ===> ");
        if (cLOOPo->op_redoop)
-           PerlIO_printf(file, "%"UVf"\n", sequence_num(aTHX_ cLOOPo->op_redoop));
+           PerlIO_printf(file, "%"UVf"\n", sequence_num(cLOOPo->op_redoop));
        else
            PerlIO_printf(file, "DONE\n");
        Perl_dump_indent(aTHX_ level, file, "NEXT ===> ");
        if (cLOOPo->op_nextop)
-           PerlIO_printf(file, "%"UVf"\n", sequence_num(aTHX_ cLOOPo->op_nextop));
+           PerlIO_printf(file, "%"UVf"\n", sequence_num(cLOOPo->op_nextop));
        else
            PerlIO_printf(file, "DONE\n");
        Perl_dump_indent(aTHX_ level, file, "LAST ===> ");
        if (cLOOPo->op_lastop)
-           PerlIO_printf(file, "%"UVf"\n", sequence_num(aTHX_ cLOOPo->op_lastop));
+           PerlIO_printf(file, "%"UVf"\n", sequence_num(cLOOPo->op_lastop));
        else
            PerlIO_printf(file, "DONE\n");
        break;
@@ -824,7 +824,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
     case OP_AND:
        Perl_dump_indent(aTHX_ level, file, "OTHER ===> ");
        if (cLOGOPo->op_other)
-           PerlIO_printf(file, "%"UVf"\n", sequence_num(aTHX_ cLOGOPo->op_other));
+           PerlIO_printf(file, "%"UVf"\n", sequence_num(cLOGOPo->op_other));
        else
            PerlIO_printf(file, "DONE\n");
        break;
@@ -941,7 +941,7 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32
                         "  MAGIC = 0x%"UVxf"\n", PTR2UV(mg));
        if (mg->mg_virtual) {
             const MGVTBL * const v = mg->mg_virtual;
-           const char *s = 0;
+           const char *s = NULL;
            if      (v == &PL_vtbl_sv)         s = "sv";
             else if (v == &PL_vtbl_env)        s = "env";
             else if (v == &PL_vtbl_envelem)    s = "envelem";
@@ -984,7 +984,7 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32
 
        {
            int n;
-           const char *name = 0;
+           const char *name = NULL;
            for (n = 0; magic_names[n].name; n++) {
                if (mg->mg_type == magic_names[n].type) {
                    name = magic_names[n].name;
@@ -1381,7 +1381,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
            PerlIO_printf(file, "  (");
            Zero(freq, FREQ_MAX + 1, int);
            for (i = 0; (STRLEN)i <= HvMAX(sv); i++) {
-               HE* h; int count = 0;
+               HE* h;
+               int count = 0;
                 for (h = HvARRAY(sv)[i]; h; h = HeNEXT(h))
                    count++;
                if (count > FREQ_MAX)
@@ -1472,12 +1473,26 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
     case SVt_PVFM:
        do_hv_dump(level, file, "  COMP_STASH", CvSTASH(sv));
        if (CvSTART(sv))
-           Perl_dump_indent(aTHX_ level, file, "  START = 0x%"UVxf" ===> %"IVdf"\n", PTR2UV(CvSTART(sv)), (IV)sequence_num(aTHX_ CvSTART(sv)));
+           Perl_dump_indent(aTHX_ level, file, "  START = 0x%"UVxf" ===> %"IVdf"\n", PTR2UV(CvSTART(sv)), (IV)sequence_num(CvSTART(sv)));
        Perl_dump_indent(aTHX_ level, file, "  ROOT = 0x%"UVxf"\n", PTR2UV(CvROOT(sv)));
         if (CvROOT(sv) && dumpops)
            do_op_dump(level+1, file, CvROOT(sv));
        Perl_dump_indent(aTHX_ level, file, "  XSUB = 0x%"UVxf"\n", PTR2UV(CvXSUB(sv)));
-       Perl_dump_indent(aTHX_ level, file, "  XSUBANY = %"IVdf"\n", (IV)CvXSUBANY(sv).any_i32);
+       {
+           SV *constant = cv_const_sv((CV *)sv);
+
+
+           if (constant) {
+               Perl_dump_indent(aTHX_ level, file, "  XSUBANY = 0x%"UVxf
+                                " (CONST SV)\n",
+                                PTR2UV(CvXSUBANY(sv).any_ptr));
+               do_sv_dump(level+1, file, constant, nest+1, maxnest, dumpops,
+                          pvlim);
+           } else {
+               Perl_dump_indent(aTHX_ level, file, "  XSUBANY = %"IVdf"\n",
+                                (IV)CvXSUBANY(sv).any_i32);
+           }
+       }
        do_gvgv_dump(level, file, "  GVGV::GV", CvGV(sv));
        Perl_dump_indent(aTHX_ level, file, "  FILE = \"%s\"\n", CvFILE(sv));
        Perl_dump_indent(aTHX_ level, file, "  DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv));
@@ -1682,7 +1697,7 @@ S_debprof(pTHX_ const OP *o)
     if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
        return;
     if (!PL_profiledata)
-       Newz(000, PL_profiledata, MAXO, U32);
+       Newxz(PL_profiledata, MAXO, U32);
     ++PL_profiledata[o->op_type];
 }