[PATCH] MARK -Ds debugging #14589
Comments
From @rurbanThis is a bug report for perl from rurban@cpanel.net, Add DEBUGGING versions of the MARK macros This might also be helpful on davem's signature op work, e.g. Flags: Site configuration information for perl 5.21.9: Configured by rurban at Sun Feb 22 17:14:55 CET 2015. Summary of my perl5 (revision 5 version 21 subversion 9) configuration: Locally applied patches: @INC for perl 5.21.9: Environment for perl 5.21.9: |
From @rurban0001-MARK-Ds-debugging.patchFrom 21330370d887e5ce7ed0dc0c1c12eb325d25c25e Mon Sep 17 00:00:00 2001
From: Reini Urban <rurban@cpanel.net>
Date: Mon, 16 Mar 2015 10:27:37 +0100
Subject: [PATCH 1/2] MARK -Ds debugging
display the MARK arity and pointers with MARK macros.
assert on markptr underflow.
---
perl.c | 4 ++--
pp.h | 51 +++++++++++++++++++++++++++++++++++++++++----------
pp_ctl.c | 12 ++++++------
pp_hot.c | 4 ++--
scope.c | 2 ++
5 files changed, 53 insertions(+), 20 deletions(-)
diff --git perl.c perl.c
index eebe150..9c02c3e 100644
--- perl.c
+++ perl.c
@@ -2736,9 +2736,9 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
}
else {
myop.op_other = (OP*)&myop;
- PL_markstack_ptr--;
+ POPMARK;
create_eval_scope(flags|G_FAKINGEVAL);
- PL_markstack_ptr++;
+ INCMARK;
JMPENV_PUSH(ret);
diff --git pp.h pp.h
index 2636dbf..3732d59 100644
--- pp.h
+++ pp.h
@@ -55,16 +55,47 @@ Refetch the stack pointer. Used after a callback. See L<perlcall>.
#define MARK mark
#define TARG targ
-#define PUSHMARK(p) \
- STMT_START { \
- I32 * mark_stack_entry; \
- if (UNLIKELY((mark_stack_entry = ++PL_markstack_ptr) == PL_markstack_max)) \
- mark_stack_entry = markstack_grow(); \
- *mark_stack_entry = (I32)((p) - PL_stack_base); \
+#ifdef DEBUGGING
+#define PUSHMARK(p) \
+ STMT_START { \
+ I32 * mark_stack_entry; \
+ if (UNLIKELY((mark_stack_entry = ++PL_markstack_ptr) == PL_markstack_max)) \
+ mark_stack_entry = markstack_grow(); \
+ *mark_stack_entry = (I32)((p) - PL_stack_base); \
+ DEBUG_s(PerlIO_printf(Perl_debug_log, "MARK push %p %d\n", \
+ PL_markstack_ptr, *mark_stack_entry)); \
} STMT_END
-
-#define TOPMARK (*PL_markstack_ptr)
-#define POPMARK (*PL_markstack_ptr--)
+#define TOPMARK \
+ ({ \
+ DEBUG_s(PerlIO_printf(Perl_debug_log, "MARK top %p %d\n", \
+ PL_markstack_ptr, *PL_markstack_ptr)); \
+ *PL_markstack_ptr; \
+ })
+#define POPMARK \
+ ({ \
+ DEBUG_s(PerlIO_printf(Perl_debug_log, "MARK pop %p %d\n", \
+ (PL_markstack_ptr-1), *(PL_markstack_ptr-1))); \
+ assert((PL_markstack_ptr > PL_markstack) || "MARK underflow");\
+ *PL_markstack_ptr--; \
+ })
+#define INCMARK \
+ ({ \
+ DEBUG_s(PerlIO_printf(Perl_debug_log, "MARK inc %p %d\n", \
+ (PL_markstack_ptr+1), *(PL_markstack_ptr+1))); \
+ *PL_markstack_ptr++; \
+ })
+#else
+#define PUSHMARK(p) \
+ STMT_START { \
+ I32 * mark_stack_entry; \
+ if (UNLIKELY((mark_stack_entry = ++PL_markstack_ptr) == PL_markstack_max)) \
+ mark_stack_entry = markstack_grow(); \
+ *mark_stack_entry = (I32)((p) - PL_stack_base); \
+ } STMT_END
+#define TOPMARK (*PL_markstack_ptr)
+#define POPMARK (*PL_markstack_ptr--)
+#define INCMARK (*PL_markstack_ptr++)
+#endif
#define dSP SV **sp = PL_stack_sp
#define djSP dSP
@@ -465,7 +496,7 @@ Does not use C<TARG>. See also C<XPUSHu>, C<mPUSHu> and C<PUSHu>.
while (jump_o->op_type == OP_NULL) \
jump_o = jump_o->op_next; \
assert(jump_o->op_type == OP_ENTERSUB); \
- PL_markstack_ptr--; \
+ POPMARK; \
return jump_o->op_next; \
} \
return NORMAL; \
diff --git pp_ctl.c pp_ctl.c
index f7cb216..409e0e3 100644
--- pp_ctl.c
+++ pp_ctl.c
@@ -921,13 +921,13 @@ PP(pp_grepstart)
dSP;
SV *src;
- if (PL_stack_base + *PL_markstack_ptr == SP) {
+ if (PL_stack_base + TOPMARK == SP) {
(void)POPMARK;
if (GIMME_V == G_SCALAR)
mXPUSHi(0);
RETURNOP(PL_op->op_next->op_next);
}
- PL_stack_sp = PL_stack_base + *PL_markstack_ptr + 1;
+ PL_stack_sp = PL_stack_base + TOPMARK + 1;
Perl_pp_pushmark(aTHX); /* push dst */
Perl_pp_pushmark(aTHX); /* push src */
ENTER_with_name("grep"); /* enter outer scope */
@@ -940,9 +940,9 @@ PP(pp_grepstart)
ENTER_with_name("grep_item"); /* enter inner scope */
SAVEVPTR(PL_curpm);
- src = PL_stack_base[*PL_markstack_ptr];
+ src = PL_stack_base[TOPMARK];
if (SvPADTMP(src)) {
- src = PL_stack_base[*PL_markstack_ptr] = sv_mortalcopy(src);
+ src = PL_stack_base[TOPMARK] = sv_mortalcopy(src);
PL_tmps_floor++;
}
SvTEMP_off(src);
@@ -961,7 +961,7 @@ PP(pp_mapwhile)
{
dSP;
const I32 gimme = GIMME_V;
- I32 items = (SP - PL_stack_base) - *PL_markstack_ptr; /* how many new items */
+ I32 items = (SP - PL_stack_base) - TOPMARK; /* how many new items */
I32 count;
I32 shift;
SV** src;
@@ -1062,7 +1062,7 @@ PP(pp_mapwhile)
LEAVE_with_name("grep_item"); /* exit inner scope */
/* All done yet? */
- if (PL_markstack_ptr[-1] > *PL_markstack_ptr) {
+ if (PL_markstack_ptr[-1] > TOPMARK) {
(void)POPMARK; /* pop top */
LEAVE_with_name("grep"); /* exit outer scope */
diff --git pp_hot.c pp_hot.c
index a820c87..5b86c5b 100644
--- pp_hot.c
+++ pp_hot.c
@@ -2923,9 +2923,9 @@ PP(pp_grepwhile)
ENTER_with_name("grep_item"); /* enter inner scope */
SAVEVPTR(PL_curpm);
- src = PL_stack_base[*PL_markstack_ptr];
+ src = PL_stack_base[TOPMARK];
if (SvPADTMP(src)) {
- src = PL_stack_base[*PL_markstack_ptr] = sv_mortalcopy(src);
+ src = PL_stack_base[TOPMARK] = sv_mortalcopy(src);
PL_tmps_floor++;
}
SvTEMP_off(src);
diff --git scope.c scope.c
index 89b4e6e..6527fd1 100644
--- scope.c
+++ scope.c
@@ -113,6 +113,8 @@ Perl_markstack_grow(pTHX)
Renew(PL_markstack, newmax, I32);
PL_markstack_max = PL_markstack + newmax;
PL_markstack_ptr = PL_markstack + oldmax;
+ DEBUG_s(PerlIO_printf(Perl_debug_log, "MARK grow %p %d by %d\n",
+ PL_markstack_ptr, *PL_markstack_ptr, oldmax));
return PL_markstack_ptr;
}
--
2.1.4
|
From @tonycozOn Mon Mar 16 03:39:29 2015, rurban@cpanel.net wrote:
This: +#define TOPMARK \ is a gcc-ism and won't work on other compilers (except maybe clang.) Similarly for POPMARK and INCMARK. Tony |
|
The RT System itself - Status changed from 'new' to 'open' |
From @rurbanOn 04/13/2015 02:02 AM, Tony Cook via RT wrote:
Right. Forgot checking for #ifdef PERL_USE_GCC_BRACE_GROUPS Attached patch should be better. |
From @rurban0001-MARK-Ds-debugging.patchFrom 990f60df9927a63a8dcf10452764214b9326fe3a Mon Sep 17 00:00:00 2001
From: Reini Urban <rurban@cpanel.net>
Date: Mon, 16 Mar 2015 10:27:37 +0100
Subject: [PATCH] MARK -Ds debugging
display the MARK arity and pointers with MARK macros.
assert on markptr underflow.
---
perl.c | 4 ++--
pp.h | 53 ++++++++++++++++++++++++++++++++++++++++++-----------
pp_ctl.c | 12 ++++++------
pp_hot.c | 4 ++--
scope.c | 2 ++
5 files changed, 54 insertions(+), 21 deletions(-)
diff --git perl.c perl.c
index eebe150..9c02c3e 100644
--- perl.c
+++ perl.c
@@ -2736,9 +2736,9 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
}
else {
myop.op_other = (OP*)&myop;
- PL_markstack_ptr--;
+ POPMARK;
create_eval_scope(flags|G_FAKINGEVAL);
- PL_markstack_ptr++;
+ INCMARK;
JMPENV_PUSH(ret);
diff --git pp.h pp.h
index 2636dbf..5e2fe0c 100644
--- pp.h
+++ pp.h
@@ -55,16 +55,47 @@ Refetch the stack pointer. Used after a callback. See L<perlcall>.
#define MARK mark
#define TARG targ
-#define PUSHMARK(p) \
- STMT_START { \
- I32 * mark_stack_entry; \
- if (UNLIKELY((mark_stack_entry = ++PL_markstack_ptr) == PL_markstack_max)) \
- mark_stack_entry = markstack_grow(); \
- *mark_stack_entry = (I32)((p) - PL_stack_base); \
- } STMT_END
-
-#define TOPMARK (*PL_markstack_ptr)
-#define POPMARK (*PL_markstack_ptr--)
+#if defined(DEBUGGING) && defined(PERL_USE_GCC_BRACE_GROUPS)
+#define PUSHMARK(p) \
+ STMT_START { \
+ I32 * mark_stack_entry; \
+ if (UNLIKELY((mark_stack_entry = ++PL_markstack_ptr) == PL_markstack_max)) \
+ mark_stack_entry = markstack_grow(); \
+ *mark_stack_entry = (I32)((p) - PL_stack_base); \
+ DEBUG_s(PerlIO_printf(Perl_debug_log, "MARK push %p %d\n", \
+ PL_markstack_ptr, *mark_stack_entry)); \
+ } STMT_END
+#define TOPMARK \
+ ({ \
+ DEBUG_s(PerlIO_printf(Perl_debug_log, "MARK top %p %d\n", \
+ PL_markstack_ptr, *PL_markstack_ptr)); \
+ *PL_markstack_ptr; \
+ })
+#define POPMARK \
+ ({ \
+ DEBUG_s(PerlIO_printf(Perl_debug_log, "MARK pop %p %d\n", \
+ (PL_markstack_ptr-1), *(PL_markstack_ptr-1))); \
+ assert((PL_markstack_ptr > PL_markstack) || "MARK underflow");\
+ *PL_markstack_ptr--; \
+ })
+#define INCMARK \
+ ({ \
+ DEBUG_s(PerlIO_printf(Perl_debug_log, "MARK inc %p %d\n", \
+ (PL_markstack_ptr+1), *(PL_markstack_ptr+1))); \
+ *PL_markstack_ptr++; \
+ })
+#else
+#define PUSHMARK(p) \
+ STMT_START { \
+ I32 * mark_stack_entry; \
+ if (UNLIKELY((mark_stack_entry = ++PL_markstack_ptr) == PL_markstack_max)) \
+ mark_stack_entry = markstack_grow(); \
+ *mark_stack_entry = (I32)((p) - PL_stack_base); \
+ } STMT_END
+#define TOPMARK (*PL_markstack_ptr)
+#define POPMARK (*PL_markstack_ptr--)
+#define INCMARK (*PL_markstack_ptr++)
+#endif
#define dSP SV **sp = PL_stack_sp
#define djSP dSP
@@ -465,7 +496,7 @@ Does not use C<TARG>. See also C<XPUSHu>, C<mPUSHu> and C<PUSHu>.
while (jump_o->op_type == OP_NULL) \
jump_o = jump_o->op_next; \
assert(jump_o->op_type == OP_ENTERSUB); \
- PL_markstack_ptr--; \
+ POPMARK; \
return jump_o->op_next; \
} \
return NORMAL; \
diff --git pp_ctl.c pp_ctl.c
index f7cb216..409e0e3 100644
--- pp_ctl.c
+++ pp_ctl.c
@@ -921,13 +921,13 @@ PP(pp_grepstart)
dSP;
SV *src;
- if (PL_stack_base + *PL_markstack_ptr == SP) {
+ if (PL_stack_base + TOPMARK == SP) {
(void)POPMARK;
if (GIMME_V == G_SCALAR)
mXPUSHi(0);
RETURNOP(PL_op->op_next->op_next);
}
- PL_stack_sp = PL_stack_base + *PL_markstack_ptr + 1;
+ PL_stack_sp = PL_stack_base + TOPMARK + 1;
Perl_pp_pushmark(aTHX); /* push dst */
Perl_pp_pushmark(aTHX); /* push src */
ENTER_with_name("grep"); /* enter outer scope */
@@ -940,9 +940,9 @@ PP(pp_grepstart)
ENTER_with_name("grep_item"); /* enter inner scope */
SAVEVPTR(PL_curpm);
- src = PL_stack_base[*PL_markstack_ptr];
+ src = PL_stack_base[TOPMARK];
if (SvPADTMP(src)) {
- src = PL_stack_base[*PL_markstack_ptr] = sv_mortalcopy(src);
+ src = PL_stack_base[TOPMARK] = sv_mortalcopy(src);
PL_tmps_floor++;
}
SvTEMP_off(src);
@@ -961,7 +961,7 @@ PP(pp_mapwhile)
{
dSP;
const I32 gimme = GIMME_V;
- I32 items = (SP - PL_stack_base) - *PL_markstack_ptr; /* how many new items */
+ I32 items = (SP - PL_stack_base) - TOPMARK; /* how many new items */
I32 count;
I32 shift;
SV** src;
@@ -1062,7 +1062,7 @@ PP(pp_mapwhile)
LEAVE_with_name("grep_item"); /* exit inner scope */
/* All done yet? */
- if (PL_markstack_ptr[-1] > *PL_markstack_ptr) {
+ if (PL_markstack_ptr[-1] > TOPMARK) {
(void)POPMARK; /* pop top */
LEAVE_with_name("grep"); /* exit outer scope */
diff --git pp_hot.c pp_hot.c
index a820c87..5b86c5b 100644
--- pp_hot.c
+++ pp_hot.c
@@ -2923,9 +2923,9 @@ PP(pp_grepwhile)
ENTER_with_name("grep_item"); /* enter inner scope */
SAVEVPTR(PL_curpm);
- src = PL_stack_base[*PL_markstack_ptr];
+ src = PL_stack_base[TOPMARK];
if (SvPADTMP(src)) {
- src = PL_stack_base[*PL_markstack_ptr] = sv_mortalcopy(src);
+ src = PL_stack_base[TOPMARK] = sv_mortalcopy(src);
PL_tmps_floor++;
}
SvTEMP_off(src);
diff --git scope.c scope.c
index 89b4e6e..6527fd1 100644
--- scope.c
+++ scope.c
@@ -113,6 +113,8 @@ Perl_markstack_grow(pTHX)
Renew(PL_markstack, newmax, I32);
PL_markstack_max = PL_markstack + newmax;
PL_markstack_ptr = PL_markstack + oldmax;
+ DEBUG_s(PerlIO_printf(Perl_debug_log, "MARK grow %p %d by %d\n",
+ PL_markstack_ptr, *PL_markstack_ptr, oldmax));
return PL_markstack_ptr;
}
--
2.1.4
|
From @tonycozOn Mon Apr 13 08:05:15 2015, rurban@cpanel.net wrote:
Thanks, I was just looking at it to apply it, but noticed: + assert((PL_markstack_ptr > PL_markstack) || "MARK underflow");\ which is an assertion that can't fail. Should that be: assert(("MARK underflow", PL_markstack_ptr > PL_markstack));\ since I'm assuming the string is there to make an assertion failure more understandable. It's kind of a pity the DEBUG_x macros use if(), otherwise each of the MARK macros you're updating could just be comma-expressions. Tony |
From @rurban
Uh, yes. Excellent catch. It should of course be: assert((PL_markstack_ptr > PL_markstack) || !"MARK underflow");\
I’m not a friend of comma expressions if pure conditionals can do the same. Reini Urban |
From @tonycozOn Thu Oct 15 00:57:36 2015, reini@cpanel.net wrote:
Applied with that changed as 6cae08a. Tony |
|
@tonycoz - Status changed from 'open' to 'resolved' |
Migrated from rt.perl.org#124080 (status was 'resolved')
Searchable as RT124080$
The text was updated successfully, but these errors were encountered: