finish implementing -DB vs. -Dx

diff --git a/dump.c b/dump.c
index c891b2f..b5c5da7 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -92,16 +92,29 @@ Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args)
 void
 Perl_dump_all(pTHX)
 {
+    dump_all_perl(aTHX_ FALSE);
+}
+
+void
+Perl_dump_all_perl(pTHX_ bool justperl)
+{
+
     dVAR;
     PerlIO_setlinebuf(Perl_debug_log);
     if (PL_main_root)
        op_dump(PL_main_root);
-    dump_packsubs(PL_defstash);
+    dump_packsubs_perl(PL_defstash, justperl);
 }
 
 void
 Perl_dump_packsubs(pTHX_ const HV *stash)
 {
+    dump_packsubs_perl(stash, FALSE);
+}
+
+void
+Perl_dump_packsubs_perl(pTHX_ const HV *stash, bool justperl)
+{
     dVAR;
     I32        i;
 
@@ -116,13 +129,13 @@ Perl_dump_packsubs(pTHX_ const HV *stash)
            if (SvTYPE(gv) != SVt_PVGV || !GvGP(gv))
                continue;
            if (GvCVu(gv))
-               dump_sub(gv);
+               dump_sub_perl(gv, justperl);
            if (GvFORM(gv))
                dump_form(gv);
            if (HeKEY(entry)[HeKLEN(entry)-1] == ':') {
                const HV * const hv = GvHV(gv);
                if (hv && (hv != PL_defstash))
-                   dump_packsubs(hv);          /* nested package */
+                   dump_packsubs_perl(hv, justperl); /* nested package */
            }
        }
     }
@@ -131,10 +144,20 @@ Perl_dump_packsubs(pTHX_ const HV *stash)
 void
 Perl_dump_sub(pTHX_ const GV *gv)
 {
-    SV * const sv = sv_newmortal();
+    dump_sub_perl(gv, FALSE);
+}
+
+void
+Perl_dump_sub_perl(pTHX_ const GV *gv, bool justperl)
+{
+    SV * sv;
 
     PERL_ARGS_ASSERT_DUMP_SUB;
 
+    if (justperl && (CvISXSUB(GvCV(gv)) || !CvROOT(GvCV(gv))))
+       return;
+
+    sv = sv_newmortal();
     gv_fullname3(sv, gv, NULL);
     Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %s = ", SvPVX_const(sv));
     if (CvISXSUB(GvCV(gv)))
@@ -2190,9 +2213,16 @@ Perl_xmldump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *ar
 void
 Perl_xmldump_all(pTHX)
 {
+    xmldump_all_perl(FALSE);
+}
+
+void
+Perl_xmldump_all_perl(pTHX_ bool justperl)
+{
     PerlIO_setlinebuf(PL_xmlfp);
     if (PL_main_root)
        op_xmldump(PL_main_root);
+    xmldump_packsubs_perl(PL_defstash, justperl)
     if (PL_xmlfp != (PerlIO*)PerlIO_stdout())
        PerlIO_close(PL_xmlfp);
     PL_xmlfp = 0;
@@ -2228,10 +2258,20 @@ Perl_xmldump_packsubs(pTHX_ const HV *stash)
 void
 Perl_xmldump_sub(pTHX_ const GV *gv)
 {
-    SV * const sv = sv_newmortal();
+    xmldump_sub_perl(gv, FALSE);
+}
+
+void
+Perl_xmldump_sub_perl(pTHX_ const GV *gv, bool justperl)
+{
+    SV * sv;
 
     PERL_ARGS_ASSERT_XMLDUMP_SUB;
 
+    if (justperl && (CvISXSUB(GvCV(gv)) || !CvROOT(GvCV(gv))))
+       return;
+
+    sv = sv_newmortal();
     gv_fullname3(sv, gv, NULL);
     Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\nSUB %s = ", SvPVX(sv));
     if (CvXSUB(GvCV(gv)))

diff --git a/embed.fnc b/embed.fnc
index 74cc604..9591a8c 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -304,6 +304,7 @@ p   |void   |do_vop         |I32 optype|NN SV* sv|NN SV* left|NN SV* right
 p      |OP*    |dofile         |NN OP* term|I32 force_builtin
 ApR    |I32    |dowantarray
 Ap     |void   |dump_all
+p      |void   |dump_all_perl  |bool justperl
 Ap     |void   |dump_eval
 #if defined(DUMP_FDS)
 Ap     |void   |dump_fds       |NN char* s
@@ -313,7 +314,9 @@ Ap  |void   |gv_dump        |NN GV* gv
 Ap     |void   |op_dump        |NN const OP *o
 Ap     |void   |pmop_dump      |NULLOK PMOP* pm
 Ap     |void   |dump_packsubs  |NN const HV* stash
+p      |void   |dump_packsubs_perl     |NN const HV* stash|bool justperl
 Ap     |void   |dump_sub       |NN const GV* gv
+p      |void   |dump_sub_perl  |NN const GV* gv|bool justperl
 Apd    |void   |fbm_compile    |NN SV* sv|U32 flags
 ApdR   |char*  |fbm_instr      |NN unsigned char* big|NN unsigned char* bigend \
                                |NN SV* littlestr|U32 flags
@@ -2133,8 +2136,11 @@ Mfp      |void   |xmldump_indent |I32 level|NN PerlIO *file|NN const char* pat \
 Mp     |void   |xmldump_vindent|I32 level|NN PerlIO *file|NN const char* pat \
                                |NULLOK va_list *args
 Mp     |void   |xmldump_all
+p      |void   |xmldump_all_perl       |bool justperl
 Mp     |void   |xmldump_packsubs       |NN const HV* stash
+p      |void   |xmldump_packsubs_perl  |NN const HV* stash|bool justperl
 Mp     |void   |xmldump_sub    |NN const GV* gv
+M      |void   |xmldump_sub_perl       |NN const GV* gv|bool justperl
 Mp     |void   |xmldump_form   |NN const GV* gv
 Mp     |void   |xmldump_eval
 Mp     |char*  |sv_catxmlsv    |NN SV *dsv|NN SV *ssv

diff --git a/embed.h b/embed.h
index fa2561f..817c291 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -232,6 +232,9 @@
 #endif
 #define dowantarray            Perl_dowantarray
 #define dump_all               Perl_dump_all
+#ifdef PERL_CORE
+#define dump_all_perl          Perl_dump_all_perl
+#endif
 #define dump_eval              Perl_dump_eval
 #if defined(DUMP_FDS)
 #define dump_fds               Perl_dump_fds
@@ -241,7 +244,13 @@
 #define op_dump                        Perl_op_dump
 #define pmop_dump              Perl_pmop_dump
 #define dump_packsubs          Perl_dump_packsubs
+#ifdef PERL_CORE
+#define dump_packsubs_perl     Perl_dump_packsubs_perl
+#endif
 #define dump_sub               Perl_dump_sub
+#ifdef PERL_CORE
+#define dump_sub_perl          Perl_dump_sub_perl
+#endif
 #define fbm_compile            Perl_fbm_compile
 #define fbm_instr              Perl_fbm_instr
 #ifdef PERL_CORE
@@ -1907,8 +1916,12 @@
 #define xmldump_indent         Perl_xmldump_indent
 #define xmldump_vindent                Perl_xmldump_vindent
 #define xmldump_all            Perl_xmldump_all
+#define xmldump_all_perl       Perl_xmldump_all_perl
 #define xmldump_packsubs       Perl_xmldump_packsubs
+#define xmldump_packsubs_perl  Perl_xmldump_packsubs_perl
 #define xmldump_sub            Perl_xmldump_sub
+#endif
+#ifdef PERL_CORE
 #define xmldump_form           Perl_xmldump_form
 #define xmldump_eval           Perl_xmldump_eval
 #define sv_catxmlsv            Perl_sv_catxmlsv
@@ -2560,6 +2573,9 @@
 #endif
 #define dowantarray()          Perl_dowantarray(aTHX)
 #define dump_all()             Perl_dump_all(aTHX)
+#ifdef PERL_CORE
+#define dump_all_perl(a)       Perl_dump_all_perl(aTHX_ a)
+#endif
 #define dump_eval()            Perl_dump_eval(aTHX)
 #if defined(DUMP_FDS)
 #define dump_fds(a)            Perl_dump_fds(aTHX_ a)
@@ -2569,7 +2585,13 @@
 #define op_dump(a)             Perl_op_dump(aTHX_ a)
 #define pmop_dump(a)           Perl_pmop_dump(aTHX_ a)
 #define dump_packsubs(a)       Perl_dump_packsubs(aTHX_ a)
+#ifdef PERL_CORE
+#define dump_packsubs_perl(a,b)        Perl_dump_packsubs_perl(aTHX_ a,b)
+#endif
 #define dump_sub(a)            Perl_dump_sub(aTHX_ a)
+#ifdef PERL_CORE
+#define dump_sub_perl(a,b)     Perl_dump_sub_perl(aTHX_ a,b)
+#endif
 #define fbm_compile(a,b)       Perl_fbm_compile(aTHX_ a,b)
 #define fbm_instr(a,b,c,d)     Perl_fbm_instr(aTHX_ a,b,c,d)
 #ifdef PERL_CORE
@@ -4256,8 +4278,11 @@
 #ifdef PERL_CORE
 #define xmldump_vindent(a,b,c,d)       Perl_xmldump_vindent(aTHX_ a,b,c,d)
 #define xmldump_all()          Perl_xmldump_all(aTHX)
+#define xmldump_all_perl(a)    Perl_xmldump_all_perl(aTHX_ a)
 #define xmldump_packsubs(a)    Perl_xmldump_packsubs(aTHX_ a)
+#define xmldump_packsubs_perl(a,b)     Perl_xmldump_packsubs_perl(aTHX_ a,b)
 #define xmldump_sub(a)         Perl_xmldump_sub(aTHX_ a)
+#define xmldump_sub_perl(a,b)  _ a,b)
 #define xmldump_form(a)                Perl_xmldump_form(aTHX_ a)
 #define xmldump_eval()         Perl_xmldump_eval(aTHX)
 #define sv_catxmlsv(a,b)       Perl_sv_catxmlsv(aTHX_ a,b)

diff --git a/mg.c b/mg.c
index c15119f..15ae6ce 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -2334,7 +2334,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 #ifdef DEBUGGING
        s = SvPV_nolen_const(sv);
        PL_debug = get_debug_opts(&s, 0) | DEBUG_TOP_FLAG;
-       DEBUG_x(dump_all());
+       DEBUG_B(dump_all());
 #else
        PL_debug = (SvIV(sv)) | DEBUG_TOP_FLAG;
 #endif

diff --git a/perl.c b/perl.c
index 7cb8530..126de99 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -2253,8 +2253,9 @@ S_run_body(pTHX_ I32 oldscope)
            exit(0);    /* less likely to core dump than my_exit(0) */
        }
 #endif
-       DEBUG_x(dump_all());
 #ifdef DEBUGGING
+       if (DEBUG_x_TEST || DEBUG_B_TEST)
+           dump_all_perl(!DEBUG_B_TEST);
        if (!DEBUG_q_TEST)
          PERL_DEBUG(PerlIO_printf(Perl_debug_log, "\nEXECUTING...\n\n"));
 #endif

diff --git a/proto.h b/proto.h
index 9734b14..724a347 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -739,6 +739,7 @@ PERL_CALLCONV I32   Perl_dowantarray(pTHX)
                        __attribute__warn_unused_result__;
 
 PERL_CALLCONV void     Perl_dump_all(pTHX);
+PERL_CALLCONV void     Perl_dump_all_perl(pTHX_ bool justperl);
 PERL_CALLCONV void     Perl_dump_eval(pTHX);
 #if defined(DUMP_FDS)
 PERL_CALLCONV void     Perl_dump_fds(pTHX_ char* s)
@@ -768,11 +769,21 @@ PERL_CALLCONV void        Perl_dump_packsubs(pTHX_ const HV* stash)
 #define PERL_ARGS_ASSERT_DUMP_PACKSUBS \
        assert(stash)
 
+PERL_CALLCONV void     Perl_dump_packsubs_perl(pTHX_ const HV* stash, bool justperl)
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_DUMP_PACKSUBS_PERL    \
+       assert(stash)
+
 PERL_CALLCONV void     Perl_dump_sub(pTHX_ const GV* gv)
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_DUMP_SUB      \
        assert(gv)
 
+PERL_CALLCONV void     Perl_dump_sub_perl(pTHX_ const GV* gv, bool justperl)
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_DUMP_SUB_PERL \
+       assert(gv)
+
 PERL_CALLCONV void     Perl_fbm_compile(pTHX_ SV* sv, U32 flags)
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_FBM_COMPILE   \
@@ -6444,16 +6455,27 @@ PERL_CALLCONV void      Perl_xmldump_vindent(pTHX_ I32 level, PerlIO *file, const cha
        assert(file); assert(pat)
 
 PERL_CALLCONV void     Perl_xmldump_all(pTHX);
+PERL_CALLCONV void     Perl_xmldump_all_perl(pTHX_ bool justperl);
 PERL_CALLCONV void     Perl_xmldump_packsubs(pTHX_ const HV* stash)
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_XMLDUMP_PACKSUBS      \
        assert(stash)
 
+PERL_CALLCONV void     Perl_xmldump_packsubs_perl(pTHX_ const HV* stash, bool justperl)
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_XMLDUMP_PACKSUBS_PERL \
+       assert(stash)
+
 PERL_CALLCONV void     Perl_xmldump_sub(pTHX_ const GV* gv)
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_XMLDUMP_SUB   \
        assert(gv)
 
+PERL_CALLCONV void     xmldump_sub_perl(pTHX_ const GV* gv, bool justperl)
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_XMLDUMP_SUB_PERL      \
+       assert(gv)
+
 PERL_CALLCONV void     Perl_xmldump_form(pTHX_ const GV* gv)
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_XMLDUMP_FORM  \