This is a live mirror of the Perl 5 development currently hosted at
https://github.com/perl/perl5
https://perl5.git.perl.org
/
perl5.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Don't bother checking for bad characters in prototypes if we're not
[perl5.git]
/
deb.c
diff --git
a/deb.c
b/deb.c
index
e47ff9b
..
1d3de4c
100644
(file)
--- a/
deb.c
+++ b/
deb.c
@@
-1,6
+1,7
@@
/* deb.c
*
/* deb.c
*
- * Copyright (c) 1991-2002, Larry Wall
+ * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1998, 1999,
+ * 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
@@
-12,6
+13,11
@@
* have seen more than thou knowest, Gray Fool." --Denethor
*/
* have seen more than thou knowest, Gray Fool." --Denethor
*/
+/*
+ * This file contains various utilities for producing debugging output
+ * (mainly related to displaying the stack)
+ */
+
#include "EXTERN.h"
#define PERL_IN_DEB_C
#include "perl.h"
#include "EXTERN.h"
#define PERL_IN_DEB_C
#include "perl.h"
@@
-26,6
+32,8
@@
Perl_deb_nocontext(const char *pat, ...)
va_start(args, pat);
vdeb(pat, &args);
va_end(args);
va_start(args, pat);
vdeb(pat, &args);
va_end(args);
+#else
+ PERL_UNUSED_ARG(pat);
#endif /* DEBUGGING */
}
#endif
#endif /* DEBUGGING */
}
#endif
@@
-38,6
+46,9
@@
Perl_deb(pTHX_ const char *pat, ...)
va_start(args, pat);
vdeb(pat, &args);
va_end(args);
va_start(args, pat);
vdeb(pat, &args);
va_end(args);
+#else
+ PERL_UNUSED_CONTEXT;
+ PERL_UNUSED_ARG(pat);
#endif /* DEBUGGING */
}
#endif /* DEBUGGING */
}
@@
-45,11
+56,16
@@
void
Perl_vdeb(pTHX_ const char *pat, va_list *args)
{
#ifdef DEBUGGING
Perl_vdeb(pTHX_ const char *pat, va_list *args)
{
#ifdef DEBUGGING
- char* file = OutCopFILE(PL_curcop);
+ dVAR;
+ const char* const file = OutCopFILE(PL_curcop);
PerlIO_printf(Perl_debug_log, "(%s:%ld)\t", (file ? file : "<free>"),
(long)CopLINE(PL_curcop));
(void) PerlIO_vprintf(Perl_debug_log, pat, *args);
PerlIO_printf(Perl_debug_log, "(%s:%ld)\t", (file ? file : "<free>"),
(long)CopLINE(PL_curcop));
(void) PerlIO_vprintf(Perl_debug_log, pat, *args);
+#else
+ PERL_UNUSED_CONTEXT;
+ PERL_UNUSED_ARG(pat);
+ PERL_UNUSED_ARG(args);
#endif /* DEBUGGING */
}
#endif /* DEBUGGING */
}
@@
-57,6
+73,7
@@
I32
Perl_debstackptrs(pTHX)
{
#ifdef DEBUGGING
Perl_debstackptrs(pTHX)
{
#ifdef DEBUGGING
+ dVAR;
PerlIO_printf(Perl_debug_log,
"%8"UVxf" %8"UVxf" %8"IVdf" %8"IVdf" %8"IVdf"\n",
PTR2UV(PL_curstack), PTR2UV(PL_stack_base),
PerlIO_printf(Perl_debug_log,
"%8"UVxf" %8"UVxf" %8"IVdf" %8"IVdf" %8"IVdf"\n",
PTR2UV(PL_curstack), PTR2UV(PL_stack_base),
@@
-86,8
+103,9
@@
S_deb_stack_n(pTHX_ SV** stack_base, I32 stack_min, I32 stack_max,
I32 mark_min, I32 mark_max)
{
#ifdef DEBUGGING
I32 mark_min, I32 mark_max)
{
#ifdef DEBUGGING
+ dVAR;
register I32 i = stack_max - 30;
register I32 i = stack_max - 30;
- I32 *markscan = PL_markstack + mark_min;
+
const
I32 *markscan = PL_markstack + mark_min;
if (i < stack_min)
i = stack_min;
if (i < stack_min)
i = stack_min;
@@
-116,6
+134,13
@@
S_deb_stack_n(pTHX_ SV** stack_base, I32 stack_min, I32 stack_max,
}
while (1);
PerlIO_printf(Perl_debug_log, "\n");
}
while (1);
PerlIO_printf(Perl_debug_log, "\n");
+#else
+ PERL_UNUSED_CONTEXT;
+ PERL_UNUSED_ARG(stack_base);
+ PERL_UNUSED_ARG(stack_min);
+ PERL_UNUSED_ARG(stack_max);
+ PERL_UNUSED_ARG(mark_min);
+ PERL_UNUSED_ARG(mark_max);
#endif /* DEBUGGING */
}
#endif /* DEBUGGING */
}
@@
-126,6
+151,7
@@
I32
Perl_debstack(pTHX)
{
#ifndef SKIP_DEBUGGING
Perl_debstack(pTHX)
{
#ifndef SKIP_DEBUGGING
+ dVAR;
if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
return 0;
if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
return 0;
@@
-143,7
+169,7
@@
Perl_debstack(pTHX)
#ifdef DEBUGGING
#ifdef DEBUGGING
-static c
har *
si_names[] = {
+static c
onst char * const
si_names[] = {
"UNKNOWN",
"UNDEF",
"MAIN",
"UNKNOWN",
"UNDEF",
"MAIN",
@@
-165,9
+191,9
@@
void
Perl_deb_stack_all(pTHX)
{
#ifdef DEBUGGING
Perl_deb_stack_all(pTHX)
{
#ifdef DEBUGGING
-
I32 ix, si_ix
;
-
PERL_SI *si
;
-
PERL_CONTEXT *cx
;
+
dVAR
;
+
I32 si_ix
;
+
const PERL_SI *si
;
/* rewind to start of chain */
si = PL_curstackinfo;
/* rewind to start of chain */
si = PL_curstackinfo;
@@
-177,18
+203,15
@@
Perl_deb_stack_all(pTHX)
si_ix=0;
for (;;)
{
si_ix=0;
for (;;)
{
- char *si_name;
- int si_name_ix = si->si_type+1; /* -1 is a valid index */
- if (si_name_ix>= sizeof(si_names))
- si_name = "????";
- else
- si_name = si_names[si_name_ix];
+ const size_t si_name_ix = si->si_type+1; /* -1 is a valid index */
+ const char * const si_name = (si_name_ix >= sizeof(si_names)) ? "????" : si_names[si_name_ix];
+ I32 ix;
PerlIO_printf(Perl_debug_log, "STACK %"IVdf": %s\n",
(IV)si_ix, si_name);
for (ix=0; ix<=si->si_cxix; ix++) {
PerlIO_printf(Perl_debug_log, "STACK %"IVdf": %s\n",
(IV)si_ix, si_name);
for (ix=0; ix<=si->si_cxix; ix++) {
- cx = &(si->si_cxstack[ix]);
+ c
onst PERL_CONTEXT * const c
x = &(si->si_cxstack[ix]);
PerlIO_printf(Perl_debug_log,
" CX %"IVdf": %-6s => ",
(IV)ix, PL_block_type[CxTYPE(cx)]
PerlIO_printf(Perl_debug_log,
" CX %"IVdf": %-6s => ",
(IV)ix, PL_block_type[CxTYPE(cx)]
@@
-205,11
+228,8
@@
Perl_deb_stack_all(pTHX)
*/
I32 i, stack_min, stack_max, mark_min, mark_max;
*/
I32 i, stack_min, stack_max, mark_min, mark_max;
- I32 ret_min, ret_max;
- PERL_CONTEXT *cx_n;
- PERL_SI *si_n;
-
- cx_n = Null(PERL_CONTEXT*);
+ const PERL_CONTEXT *cx_n = NULL;
+ const PERL_SI *si_n;
/* there's a separate stack per SI, so only search
* this one */
/* there's a separate stack per SI, so only search
* this one */
@@
-238,7
+258,7
@@
Perl_deb_stack_all(pTHX)
si_n = si;
i = ix;
si_n = si;
i = ix;
- cx_n = N
ull(PERL_CONTEXT*)
;
+ cx_n = N
ULL
;
for (;;) {
i++;
if (i > si_n->si_cxix) {
for (;;) {
i++;
if (i > si_n->si_cxix) {
@@
-256,27
+276,26
@@
Perl_deb_stack_all(pTHX)
}
mark_min = cx->blk_oldmarksp;
}
mark_min = cx->blk_oldmarksp;
- ret_min = cx->blk_oldretsp;
if (cx_n) {
mark_max = cx_n->blk_oldmarksp;
if (cx_n) {
mark_max = cx_n->blk_oldmarksp;
- ret_max = cx_n->blk_oldretsp;
}
else {
mark_max = PL_markstack_ptr - PL_markstack;
}
else {
mark_max = PL_markstack_ptr - PL_markstack;
- ret_max = PL_retstack_ix;
}
deb_stack_n(AvARRAY(si->si_stack),
stack_min, stack_max, mark_min, mark_max);
}
deb_stack_n(AvARRAY(si->si_stack),
stack_min, stack_max, mark_min, mark_max);
- if (ret_max > ret_min) {
+ if (CxTYPE(cx) == CXt_EVAL || CxTYPE(cx) == CXt_SUB
+ || CxTYPE(cx) == CXt_FORMAT)
+ {
+ const OP * const retop = (CxTYPE(cx) == CXt_EVAL)
+ ? cx->blk_eval.retop : cx->blk_sub.retop;
+
PerlIO_printf(Perl_debug_log, " retop=%s\n",
PerlIO_printf(Perl_debug_log, " retop=%s\n",
- PL_retstack[ret_min]
- ? OP_NAME(PL_retstack[ret_min])
- : "(null)"
+ retop ? OP_NAME(retop) : "(null)"
);
}
);
}
-
}
} /* next context */
}
} /* next context */
@@
-290,7
+309,17
@@
Perl_deb_stack_all(pTHX)
} /* next stackinfo */
PerlIO_printf(Perl_debug_log, "\n");
} /* next stackinfo */
PerlIO_printf(Perl_debug_log, "\n");
+#else
+ PERL_UNUSED_CONTEXT;
#endif /* DEBUGGING */
}
#endif /* DEBUGGING */
}
-
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */