;-);-);-);-);-);-);-);-);-);-)
Below is the patch that allows you to debug the statements entered from
the debugger command line. You can press ^C and/or use new extended
t expr
n expr
s expr
commands. There are several small glitches (like subroutines inserted
from the command line have unknown text), but it looks very useful.
Big problems: a) one line in C code should be corrected;
b) pp_caller goes overboard trying to avoid debug
subroutine from its list. Obviously, it does not expect to see it
_several times_ in the list. As a result, you get a segfault.
Since I do not use 'T' command of debugger, I'm afraid somebody else
should look for it ;-).
Patch is with respect to my improved debugger, I expect that you get 2
failed chunks when applied against the standard one. One of two
contains visual feedback on how deep you are, please do it manually.
*** F:/perl5/lib/perl5db.pl Fri Aug 11 02:27:24 1995
--- perl5db.pl Sun Aug 27 21:35:36 1995
***************
*** 86,93 ****
$help = "
T Stack trace.
! s Single step.
! n Next, steps over subroutine calls.
r Return from current subroutine.
c [line] Continue; optionally inserts a one-time-only breakpoint
at the specified line.
--- 86,93 ----
$help = "
T Stack trace.
! s [expr] Single step (in expr).
! n [expr] Next, steps over subroutine calls (in expr).
r Return from current subroutine.
c [line] Continue; optionally inserts a one-time-only breakpoint
at the specified line.
***************
*** 105,110 ****
--- 105,111 ----
L List breakpoints and actions.
S [[!]pattern] List subroutine names.
t Toggle trace mode.
+ t expr Trace through execution of expr.
b [line] [condition]
Set breakpoint; line defaults to the current execution line;
condition breaks if it evaluates to true, defaults to \'1\'.
***************
*** 171,177 ****
undefPrint => 'dumpvar.pl',
globPrint => 'dumpvar.pl',
);
!
@ARGS;
sub DB {
--- 172,179 ----
undefPrint => 'dumpvar.pl',
globPrint => 'dumpvar.pl',
);
! $db_stop = 1 << 31;
! $level = 0; # Level of recursive debugging
@ARGS;
sub DB {
***************
*** 185,191 ****
&save;
($package, $filename, $line) = caller;
$usercontext = '($@, $!, $,, $/, $\, $^W) = @saved;' .
! "package $package;"; # this won't let them modify, alas
local(*dbline) = "::_<$filename";
$max = $#dbline;
if (($stop,$action) = split(/\0/,$dbline{$line})) {
--- 187,194 ----
&save;
($package, $filename, $line) = caller;
$usercontext = '($@, $!, $,, $/, $\, $^W) = @saved;' .
! 'local $^D = $^D | $DB::db_stop; ' .
! "package $package;\n"; # this won't let them modify, alas
local(*dbline) = "::_<$filename";
$max = $#dbline;
if (($stop,$action) = split(/\0/,$dbline{$line})) {
***************
*** 221,233 ****
}
$evalarg = $action, &eval if $action;
if ($single || $signal) {
$evalarg = $pre, &eval if $pre;
print $OUT $#stack . " levels deep in subroutine calls!\n"
if $single & 4;
$start = $line;
CMD:
while (($term || &setterm),
! defined ($cmd=$term->readline(" DB<" . ($#hist+1) . "> "))) {
{
$single = 0;
$signal = 0;
--- 224,239 ----
}
$evalarg = $action, &eval if $action;
if ($single || $signal) {
+ local $level = $level + 1;
$evalarg = $pre, &eval if $pre;
print $OUT $#stack . " levels deep in subroutine calls!\n"
if $single & 4;
$start = $line;
CMD:
while (($term || &setterm),
! defined ($cmd=$term->readline(" DB" . ('<' x $level) .
! ($#hist+1) . ('>' x $level) .
! " "))) {
{
$single = 0;
$signal = 0;
***************
*** 470,483 ****
$single = 1;
$laststep = $cmd;
last CMD; };
- # Does not work:
- $cmd =~ s/^n\s/ / && do { # Space to inhibit recursion
- $single = 2;
- };
- # Does not work:
- $cmd =~ s/^s\s/ / && do { # Space to inhibit recursion
- $single = 1;
- };
$cmd =~ /^c\b\s*(\d*)\s*$/ && do {
$i = $1;
if ($i) {
--- 476,481 ----
***************
*** 615,620 ****
--- 613,622 ----
};
};
next CMD; };
+ # XXX Local variants do not work?!!!
+ $cmd =~ s/^t\s/\$DB::trace = 1;\n/;
+ $cmd =~ s/^s\s/\$DB::single = 1;\n/;
+ $cmd =~ s/^n\s/\$DB::single = 2;\n/;
}
$evalarg = $cmd; &eval;
if ($onetimeDump) {
***************
*** 639,645 ****
# The following takes its argument via $evalarg to preserve current @_
sub eval {
! my @res = eval "$usercontext $evalarg;";
my $at = $@;
eval "&DB::save";
if ($at) {
--- 641,655 ----
# The following takes its argument via $evalarg to preserve current @_
sub eval {
! my @res;
! {
! local (@stack) = @stack; # guard against recursive debugging
! my $otrace = $trace;
! my $osingle = $single;
! @res = eval "$usercontext $evalarg;\n"; # '\n' for nice recursive debug
! $trace = $otrace;
! $single = $osingle;
! }
my $at = $@;
eval "&DB::save";
if ($at) {
*** pp_ctl.c~ Fri Aug 25 03:42:36 1995
--- pp_ctl.c Sun Aug 27 23:00:33 1995
***************
*** 1200,1206 ****
if (!cv)
DIE("No DB::DB routine defined");
! if (CvDEPTH(cv) >= 1) /* don't do recursive DB::DB call */
return NORMAL;
SAVEI32(debug);
--- 1200,1206 ----
if (!cv)
DIE("No DB::DB routine defined");
! if (CvDEPTH(cv) >= 1 && !(debug & (1<<31))) /* don't do recursive DB::DB call */
return NORMAL;
SAVEI32(debug);
Enjoy,
Ilya
Below is the patch that allows you to debug the statements entered from
the debugger command line. You can press ^C and/or use new extended
t expr
n expr
s expr
commands. There are several small glitches (like subroutines inserted
from the command line have unknown text), but it looks very useful.
Big problems: a) one line in C code should be corrected;
b) pp_caller goes overboard trying to avoid debug
subroutine from its list. Obviously, it does not expect to see it
_several times_ in the list. As a result, you get a segfault.
Since I do not use 'T' command of debugger, I'm afraid somebody else
should look for it ;-).
Patch is with respect to my improved debugger, I expect that you get 2
failed chunks when applied against the standard one. One of two
contains visual feedback on how deep you are, please do it manually.
*** F:/perl5/lib/perl5db.pl Fri Aug 11 02:27:24 1995
--- perl5db.pl Sun Aug 27 21:35:36 1995
***************
*** 86,93 ****
$help = "
T Stack trace.
! s Single step.
! n Next, steps over subroutine calls.
r Return from current subroutine.
c [line] Continue; optionally inserts a one-time-only breakpoint
at the specified line.
--- 86,93 ----
$help = "
T Stack trace.
! s [expr] Single step (in expr).
! n [expr] Next, steps over subroutine calls (in expr).
r Return from current subroutine.
c [line] Continue; optionally inserts a one-time-only breakpoint
at the specified line.
***************
*** 105,110 ****
--- 105,111 ----
L List breakpoints and actions.
S [[!]pattern] List subroutine names.
t Toggle trace mode.
+ t expr Trace through execution of expr.
b [line] [condition]
Set breakpoint; line defaults to the current execution line;
condition breaks if it evaluates to true, defaults to \'1\'.
***************
*** 171,177 ****
undefPrint => 'dumpvar.pl',
globPrint => 'dumpvar.pl',
);
!
@ARGS;
sub DB {
--- 172,179 ----
undefPrint => 'dumpvar.pl',
globPrint => 'dumpvar.pl',
);
! $db_stop = 1 << 31;
! $level = 0; # Level of recursive debugging
@ARGS;
sub DB {
***************
*** 185,191 ****
&save;
($package, $filename, $line) = caller;
$usercontext = '($@, $!, $,, $/, $\, $^W) = @saved;' .
! "package $package;"; # this won't let them modify, alas
local(*dbline) = "::_<$filename";
$max = $#dbline;
if (($stop,$action) = split(/\0/,$dbline{$line})) {
--- 187,194 ----
&save;
($package, $filename, $line) = caller;
$usercontext = '($@, $!, $,, $/, $\, $^W) = @saved;' .
! 'local $^D = $^D | $DB::db_stop; ' .
! "package $package;\n"; # this won't let them modify, alas
local(*dbline) = "::_<$filename";
$max = $#dbline;
if (($stop,$action) = split(/\0/,$dbline{$line})) {
***************
*** 221,233 ****
}
$evalarg = $action, &eval if $action;
if ($single || $signal) {
$evalarg = $pre, &eval if $pre;
print $OUT $#stack . " levels deep in subroutine calls!\n"
if $single & 4;
$start = $line;
CMD:
while (($term || &setterm),
! defined ($cmd=$term->readline(" DB<" . ($#hist+1) . "> "))) {
{
$single = 0;
$signal = 0;
--- 224,239 ----
}
$evalarg = $action, &eval if $action;
if ($single || $signal) {
+ local $level = $level + 1;
$evalarg = $pre, &eval if $pre;
print $OUT $#stack . " levels deep in subroutine calls!\n"
if $single & 4;
$start = $line;
CMD:
while (($term || &setterm),
! defined ($cmd=$term->readline(" DB" . ('<' x $level) .
! ($#hist+1) . ('>' x $level) .
! " "))) {
{
$single = 0;
$signal = 0;
***************
*** 470,483 ****
$single = 1;
$laststep = $cmd;
last CMD; };
- # Does not work:
- $cmd =~ s/^n\s/ / && do { # Space to inhibit recursion
- $single = 2;
- };
- # Does not work:
- $cmd =~ s/^s\s/ / && do { # Space to inhibit recursion
- $single = 1;
- };
$cmd =~ /^c\b\s*(\d*)\s*$/ && do {
$i = $1;
if ($i) {
--- 476,481 ----
***************
*** 615,620 ****
--- 613,622 ----
};
};
next CMD; };
+ # XXX Local variants do not work?!!!
+ $cmd =~ s/^t\s/\$DB::trace = 1;\n/;
+ $cmd =~ s/^s\s/\$DB::single = 1;\n/;
+ $cmd =~ s/^n\s/\$DB::single = 2;\n/;
}
$evalarg = $cmd; &eval;
if ($onetimeDump) {
***************
*** 639,645 ****
# The following takes its argument via $evalarg to preserve current @_
sub eval {
! my @res = eval "$usercontext $evalarg;";
my $at = $@;
eval "&DB::save";
if ($at) {
--- 641,655 ----
# The following takes its argument via $evalarg to preserve current @_
sub eval {
! my @res;
! {
! local (@stack) = @stack; # guard against recursive debugging
! my $otrace = $trace;
! my $osingle = $single;
! @res = eval "$usercontext $evalarg;\n"; # '\n' for nice recursive debug
! $trace = $otrace;
! $single = $osingle;
! }
my $at = $@;
eval "&DB::save";
if ($at) {
*** pp_ctl.c~ Fri Aug 25 03:42:36 1995
--- pp_ctl.c Sun Aug 27 23:00:33 1995
***************
*** 1200,1206 ****
if (!cv)
DIE("No DB::DB routine defined");
! if (CvDEPTH(cv) >= 1) /* don't do recursive DB::DB call */
return NORMAL;
SAVEI32(debug);
--- 1200,1206 ----
if (!cv)
DIE("No DB::DB routine defined");
! if (CvDEPTH(cv) >= 1 && !(debug & (1<<31))) /* don't do recursive DB::DB call */
return NORMAL;
SAVEI32(debug);
Enjoy,
Ilya