Re: Debugger in beta3

2 files changed, 235 insertions, 92 deletions

diff --git a/lib/dumpvar.pl b/lib/dumpvar.pl
index c78319b539..06c0930581 100644
--- a/lib/dumpvar.pl
+++ b/lib/dumpvar.pl
@@ -19,8 +19,9 @@ $winsize = 80 unless defined $winsize;
 
 # $globPrint = 1;
 $printUndef = 1 unless defined $printUndef;
-$tick = "'" unless defined $tick;
+$tick = "auto" unless defined $tick;
 $unctrl = 'quote' unless defined $unctrl;
+$subdump = 1;
 
 sub main::dumpValue {
   local %address;
@@ -43,9 +44,17 @@ sub unctrl {
 sub stringify {
 	local($_,$noticks) = @_;
 	local($v) ; 
+	my $tick = $tick;
 
 	return 'undef' unless defined $_ or not $printUndef;
 	return $_ . "" if ref \$_ eq 'GLOB';
+	if ($tick eq 'auto') {
+	  if (/[\000-\011\013-\037\177]/) {
+	    $tick = '"';
+	  }else {
+	    $tick = "'";
+	  }
+	}
 	if ($tick eq "'") {
 	  s/([\'\\])/\\$1/g;
 	} elsif ($unctrl eq 'unctrl') {
@@ -168,8 +177,10 @@ sub unwrap {
 	$shortmore = " ..." if $tArrayDepth < $#{$v} ;
 	if ($compactDump && !grep(ref $_, @{$v})) {
 	  if ($#$v >= 0) {
-	    $short = $sp . "0..$#{$v}  '" . 
-	      join("' '", @{$v}[0..$tArrayDepth]) . "'$shortmore";
+	    $short = $sp . "0..$#{$v}  " . 
+	      join(" ", 
+		   map {stringify $_} @{$v}[0..$tArrayDepth])
+		. "$shortmore";
 	  } else {
 	    $short = $sp . "empty array";
 	  }
@@ -189,6 +200,9 @@ sub unwrap {
     } elsif ( ref $v eq 'SCALAR' or ref $v eq 'REF' or $type eq 'SCALAR' ) { 
 	    print "$sp-> ";
 	    DumpElem $$v, $s;
+    } elsif ( ref $v eq 'CODE' or $type eq 'CODE' ) { 
+	    print "$sp-> ";
+	    dumpsub (0, $v);
     } elsif (ref $v eq 'GLOB') {
       print "$sp-> ",&stringify($$v,1),"\n";
       if ($globPrint) {
@@ -240,6 +254,9 @@ sub quote {
   if (@_ and $_[0] eq '"') {
     $tick = '"';
     $unctrl = 'quote';
+  } elsif (@_ and $_[0] eq 'auto') {
+    $tick = 'auto';
+    $unctrl = 'quote';
   } elsif (@_) {		# Need to set
     $tick = "'";
     $unctrl = 'unctrl';
@@ -252,7 +269,7 @@ sub dumpglob {
     my ($off,$key, $val, $all) = @_;
     local(*entry) = $val;
     my $fileno;
-    if (defined $entry) {
+    if (($key !~ /^_</ or $dumpDBFiles) and defined $entry) {
       print( (' ' x $off) . "\$", &unctrl($key), " = " );
       DumpElem $entry, 3+$off;
     }
@@ -263,6 +280,7 @@ sub dumpglob {
     }
     if ($key ne "main::" && $key ne "DB::" && defined %entry
 	&& ($dumpPackages or $key !~ /::$/)
+	&& ($key !~ /^_</ or $dumpDBFiles)
 	&& !($package eq "dumpvar" and $key eq "stab")) {
       print( (' ' x $off) . "\%$key = (\n" );
       unwrap(\%entry,3+$off) ;
@@ -273,15 +291,32 @@ sub dumpglob {
     }
     if ($all) {
       if (defined &entry) {
-	my $sub = $key;
-	$sub = $1 if $sub =~ /^\{\*(.*)\}$/;
-	my $place = $DB::sub{$sub};
-	$place = '???' unless defined $place;
-	print( (' ' x $off) .  "&$sub in $place\n" );
+	dumpsub($off, $key);
       }
     }
 }
 
+sub dumpsub {
+    my ($off,$sub) = @_;
+    $sub = $1 if $sub =~ /^\{\*(.*)\}$/;
+    my $subref = \&$sub;
+    my $place = $DB::sub{$sub} || (($sub = $subs{"$subref"}) && $DB::sub{$sub})
+      || ($subdump && ($sub = findsubs("$subref")) && $DB::sub{$sub});
+    $place = '???' unless defined $place;
+    print( (' ' x $off) .  "&$sub in $place\n" );
+}
+
+sub findsubs {
+  return undef unless defined %DB::sub;
+  my ($addr, $name, $loc);
+  while (($name, $loc) = each %DB::sub) {
+    $addr = \&$name;
+    $subs{"$addr"} = $name;
+  }
+  $subdump = 0;
+  $subs{ shift() };
+}
+
 sub main::dumpvar {
     my ($package,@vars) = @_;
     local(%address,$key,$val);
@@ -371,46 +406,3 @@ sub packageUsage {
 
 1;
 
-package dumpvar;
-
-# translate control chars to ^X - Randal Schwartz
-sub unctrl {
-	local($_) = @_;
-	return \$_ if ref \$_ eq "GLOB";
-	s/([\001-\037\177])/'^'.pack('c',ord($1)^64)/eg;
-	$_;
-}
-sub main'dumpvar {
-    ($package,@vars) = @_;
-    $package .= "::" unless $package =~ /::$/;
-    *stab = *{"main::"};
-    while ($package =~ /(\w+?::)/g){
-	*stab = ${stab}{$1};
-    }
-    while (($key,$val) = each(%stab)) {
-	{
-	    next if @vars && !grep($key eq $_,@vars);
-	    local(*entry) = $val;
-	    if (defined $entry) {
-		print "\$",&unctrl($key)," = '",&unctrl($entry),"'\n";
-	    }
-	    if (defined @entry) {
-		print "\@$key = (\n";
-		foreach $num ($[ .. $#entry) {
-		    print "  $num\t'",&unctrl($entry[$num]),"'\n";
-		}
-		print ")\n";
-	    }
-	    if ($key ne "main::" && $key ne "DB::" && defined %entry
-		&& !($package eq "dumpvar" and $key eq "stab")) {
-		print "\%$key = (\n";
-		foreach $key (sort keys(%entry)) {
-		    print "  $key\t'",&unctrl($entry{$key}),"'\n";
-		}
-		print ")\n";
-	    }
-	}
-    }
-}
-
-1;
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 711003a511..5c8d2727b7 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -1,8 +1,8 @@
 package DB;
 
-# Debugger for Perl 5.001m; perl5db.pl patch level:
+# Debugger for Perl 5.00x; perl5db.pl patch level:
 
-$header = 'perl5db.pl patch level 0.93';
+$header = 'perl5db.pl patch level 0.94';
 
 # Enhanced by ilya@math.ohio-state.edu (Ilya Zakharevich)
 # Latest version available: ftp://ftp.math.ohio-state.edu/pub/users/ilya/perl
@@ -64,8 +64,10 @@ $header = 'perl5db.pl patch level 0.93';
 # reset LineInfo to something "interactive"!)
 #
 
+# Needed for the statement after exec():
 
-local($^W) = 0;
+BEGIN { $ini_warn = $^W; $^W = 0 } # Switch compilation warnings off until another BEGIN.
+local($^W) = 0;			# Switch run-time warnings off during init.
 warn (			# Do not ;-)
       $dumpvar::hashDepth,     
       $dumpvar::arrayDepth,    
@@ -78,8 +80,13 @@ warn (			# Do not ;-)
       $dumpvar::usageOnly,
       @ARGS,
       $Carp::CarpLevel,
+      $panic,
+      $first_time,
      ) if 0;
 
+# Command-line + PERLLIB:
+@ini_INC = @INC;
+
 # $prevwarn = $prevdie = $prevbus = $prevsegv = ''; # Does not help?!
 
 $trace = $signal = $single = 0;	# Uninitialized warning suppression
@@ -158,6 +165,24 @@ if (defined $ENV{PERLDB_OPTS}) {
   parse_options($ENV{PERLDB_OPTS});
 }
 
+if (exists $ENV{PERLDB_RESTART}) {
+  delete $ENV{PERLDB_RESTART};
+  # $restart = 1;
+  @hist = get_list('PERLDB_HIST');
+  my @visited = get_list("PERLDB_VISITED");
+  for (0 .. $#visited) {
+    %{$postponed{$visited[$_]}} = get_list("PERLDB_FILE_$_");
+  }
+  my %opt = get_list("PERLDB_OPT");
+  my ($opt,$val);
+  while (($opt,$val) = each %opt) {
+    $val =~ s/[\\\']/\\$1/g;
+    parse_options("$opt'$val'");
+  }
+  @INC = get_list("PERLDB_INC");
+  @ini_INC = @INC;
+}
+
 if ($notty) {
   $runnonstop = 1;
 } else {
@@ -226,16 +251,23 @@ if (defined &afterinit) {	# May be defined in $rcfile
 
 ############################################################ Subroutines
 
-# The following code may be executed now, but gives FPE later:
-# BEGIN {warn 5}
-
 sub DB {
-    if ($runnonstop) {		# Disable until signal
+    unless ($first_time++) {	# Do when-running init
+      if ($runnonstop) {		# Disable until signal
 	for ($i=0; $i <= $#stack; ) {
 	    $stack[$i++] &= ~1;
 	}
-	$single = $runnonstop = 0; # Once only
+	$single = 0;
 	return;
+      }
+      # Define a subroutine in which we will stop
+#       eval <<'EOE';
+# sub at_end::db {"Debuggee terminating";}
+# END {
+#   $DB::step = 1; 
+#   print $OUT "Debuggee terminating.\n"; 
+#   &at_end::db;}
+# EOE
     }
     &save;
     if ($doret) {
@@ -247,14 +279,16 @@ sub DB {
 	}
     }
     ($package, $filename, $line) = caller;
+    $filename_ini = $filename;
     $usercontext = '($@, $!, $,, $/, $\, $^W) = @saved;' .
       "package $package;";	# this won't let them modify, alas
     local(*dbline) = "::_<$filename";
+    install_breakpoints($filename) unless $visited{$filename}++;
     $max = $#dbline;
     if (($stop,$action) = split(/\0/,$dbline{$line})) {
 	if ($stop eq '1') {
 	    $signal |= 1;
-	} else {
+	} elsif ($stop) {
 	    $evalarg = "\$DB::signal |= do {$stop;}"; &eval;
 	    $dbline{$line} =~ s/;9($|\0)/$1/;
 	}
@@ -262,24 +296,29 @@ sub DB {
     if ($single || $trace || $signal) {
 	$term || &setterm;
 	if ($emacs) {
-	    print $LINEINFO "\032\032$filename:$line:0\n";
+	    $position = "\032\032$filename:$line:0\n";
+	    print $LINEINFO $position;
 	} else {
 	    $sub =~ s/\'/::/;
 	    $prefix = $sub =~ /::/ ? "" : "${'package'}::";
 	    $prefix .= "$sub($filename:";
 	    $after = ($dbline[$line] =~ /\n$/ ? '' : "\n");
 	    if (length($prefix) > 30) {
-		print $LINEINFO "$prefix$line):\n$line:\t", $dbline[$line], $after;
+	        $position = "$prefix$line):\n$line:\t$dbline[$line]$after";
+		print $LINEINFO $position;
 		$prefix = "";
 		$infix = ":\t";
 	    } else {
 		$infix = "):\t";
-		print $LINEINFO "$prefix$line$infix",$dbline[$line], $after;
+		$position = "$prefix$line$infix$dbline[$line]$after";
+		print $LINEINFO $position;
 	    }
 	    for ($i = $line + 1; $i <= $max && $dbline[$i] == 0; ++$i) { #{ vi
 		last if $dbline[$i] =~ /^\s*[\;\}\#\n]/;
 		$after = ($dbline[$i] =~ /\n$/ ? '' : "\n");
-		print $LINEINFO "$prefix$i$infix", $dbline[$i], $after;
+		$incr_pos = "$prefix$i$infix$dbline[$i]$after";
+		print $LINEINFO $incr_pos;
+		$position .= $incr_pos;
 	    }
 	}
     }
@@ -292,14 +331,14 @@ sub DB {
 	$start = $line;
       CMD:
 	while (($term || &setterm),
-	       defined ($cmd=$term->readline("  DB" . ('<' x $level) .
-					     ($#hist+1) . ('>' x $level) .
-					     " "))) {
-	    {			# <-- Do we know what this brace is for?
+	       defined ($cmd=&readline("  DB" . ('<' x $level) .
+				       ($#hist+1) . ('>' x $level) .
+				       " "))) {
+	    #{			# <-- Do we know what this brace is for?
 		$single = 0;
 		$signal = 0;
 		$cmd =~ s/\\$/\n/ && do {
-		    $cmd .= $term->readline("  cont: ");
+		    $cmd .= &readline("  cont: ");
 		    redo CMD;
 		};
 		$cmd =~ /^q$/ && exit 0;
@@ -343,6 +382,7 @@ sub DB {
 			@vars = split(' ',$2);
 			do 'dumpvar.pl' unless defined &main::dumpvar;
 			if (defined &main::dumpvar) {
+			    local $frame = 0;
 			    &main::dumpvar($packname,@vars);
 			} else {
 			    print $OUT "dumpvar.pl not available.\n";
@@ -369,6 +409,7 @@ sub DB {
 			    next CMD;
 			} elsif ($file ne $filename) {
 			    *dbline = "::_<$file";
+			    $visited{$file}++;
 			    $max = $#dbline;
 			    $filename = $file;
 			    $start = 1;
@@ -384,6 +425,7 @@ sub DB {
 			$file = join(':', @pieces);
 			if ($file ne $filename) {
 			    *dbline = "::_<$file";
+			    $visited{$file}++;
 			    $max = $#dbline;
 			    $filename = $file;
 			}
@@ -396,10 +438,18 @@ sub DB {
 			    print $OUT "Subroutine $subname not found.\n";
 			    next CMD;
 			} };
+		    $cmd =~ /^\.$/ && do {
+			$start = $line;
+			$filename = $filename_ini;
+			*dbline = "::_<$filename";
+			$max = $#dbline;
+			print $LINEINFO $position;
+			next CMD };
 		    $cmd =~ /^w\b\s*(\d*)$/ && do {
 			$incr = $window - 1;
 			$start = $1 if $1;
 			$start -= $preview;
+			#print $OUT 'l ' . $start . '-' . ($start + $incr);
 			$cmd = 'l ' . $start . '-' . ($start + $incr); };
 		    $cmd =~ /^-$/ && do {
 			$incr = $window - 1;
@@ -412,8 +462,8 @@ sub DB {
 			$incr = $2;
 			$incr = $window - 1 unless $incr;
 			$cmd = 'l ' . $start . '-' . ($start + $incr); };
-		    $cmd =~ /^l\b\s*(([\d\$\.]+)([-,]([\d\$\.]+))?)?/ && do {
-			$end = (!$2) ? $max : ($4 ? $4 : $2);
+		    $cmd =~ /^l\b\s*((-?[\d\$\.]+)([-,]([\d\$\.]+))?)?/ && do {
+			$end = (!defined $2) ? $max : ($4 ? $4 : $2);
 			$end = $max if $end > $max;
 			$i = $2;
 			$i = $line if $i eq '.';
@@ -423,7 +473,14 @@ sub DB {
 			    $i = $end;
 			} else {
 			    for (; $i <= $end; $i++) {
-				print $OUT "$i:\t", $dbline[$i];
+			        ($stop,$action) = split(/\0/, $dbline{$i});
+			        $arrow = ($i==$line 
+					  and $filename eq $filename_ini) 
+				  ?  '==>' 
+				    : ':' ;
+				$arrow .= 'b' if $stop;
+				$arrow .= 'a' if $action;
+				print $OUT "$i$arrow\t", $dbline[$i];
 				last if $signal;
 			    }
 			}
@@ -467,6 +524,7 @@ sub DB {
 			if ($i) {
 			    $filename = $file;
 			    *dbline = "::_<$filename";
+			    $visited{$filename}++;
 			    $max = $#dbline;
 			    ++$i while $dbline[$i] == 0 && $i < $max;
 			    $dbline{$i} =~ s/^[^\0]*/$cond/;
@@ -527,8 +585,22 @@ sub DB {
 			$single = 1;
 			$laststep = $cmd;
 			last CMD; };
-		    $cmd =~ /^c\b\s*(\d*)\s*$/ && do {
+		    $cmd =~ /^c\b\s*([\w:]*)\s*$/ && do {
 			$i = $1;
+			if ($i =~ /\D/) { # subroutine name
+			    ($file,$i) = ($sub{$i} =~ /^(.*):(.*)$/);
+			    $i += 0;
+			    if ($i) {
+			        $filename = $file;
+				*dbline = "::_<$filename";
+				$visited{$filename}++;
+				$max = $#dbline;
+				++$i while $dbline[$i] == 0 && $i < $max;
+			    } else {
+				print $OUT "Subroutine $subname not found.\n";
+				next CMD; 
+			    }
+			}
 			if ($i) {
 			    if ($dbline[$i] == 0) {
 				print $OUT "Line $i not breakable.\n";
@@ -544,6 +616,40 @@ sub DB {
 			$stack[$#stack] |= 1;
 			$doret = 1;
 			last CMD; };
+		    $cmd =~ /^R$/ && do {
+		        print $OUT "Warning: a lot of settings and command-line options may be lost!\n";
+			my (@script, @flags, $cl);
+			push @flags, '-w' if $ini_warn;
+			# Put all the old includes at the start to get
+			# the same debugger.
+			for (@ini_INC) {
+			  push @flags, '-I', $_;
+			}
+			# Arrange for setting the old INC:
+			set_list("PERLDB_INC", @ini_INC);
+			if ($0 eq '-e') {
+			  for (1..$#{'::_<-e'}) { # The first line is PERL5DB
+			    chomp ($cl =  $ {'::_<-e'}[$_]);
+			    push @script, '-e', $cl;
+			  }
+			} else {
+			  @script = $0;
+			}
+			set_list("PERLDB_HIST", 
+				 $term->Features->{getHistory} 
+				 ? $term->GetHistory : @hist);
+			my @visited = keys %visited;
+			set_list("PERLDB_VISITED", @visited);
+			set_list("PERLDB_OPT", %option);
+			for (0 .. $#visited) {
+			  *dbline = "::_<$visited[$_]";
+			  set_list("PERLDB_FILE_$_", %dbline);
+			}
+			$ENV{PERLDB_RESTART} = 1;
+			#print "$^X, '-d', @flags, @script, ($emacs ? '-emacs' : ()), @ARGS";
+			exec $^X, '-d', @flags, @script, ($emacs ? '-emacs' : ()), @ARGS;
+			print $OUT "exec failed: $!\n";
+			last CMD; };
 		    $cmd =~ /^T$/ && do {
 			local($p,$f,$l,$s,$h,$a,$e,$r,@a,@sub);
 			for ($i = 1; 
@@ -718,7 +824,7 @@ sub DB {
 		    $cmd =~ s/^s\s/\$DB::single = 1;\n/ && do {$laststep = 's'};
 		    $cmd =~ s/^n\s/\$DB::single = 2;\n/ && do {$laststep = 'n'};
 		}		# PIPE:
-	    }			# <-- Do we know what this brace is for?
+	    #}			# <-- Do we know what this brace is for?
 	    $evalarg = "\$^D = \$^D | \$DB::db_stop;\n$cmd"; &eval;
 	    if ($onetimeDump) {
 		$onetimeDump = undef;
@@ -807,10 +913,23 @@ sub eval {
     }
 }
 
+sub install_breakpoints {
+  my $filename = shift;
+  return unless exists $postponed{$filename};
+  my %break = %{$postponed{$filename}};
+  for (keys %break) {
+    my $i = $_;
+    #if (/\D/) {			# Subroutine name
+    #} 
+    $dbline{$i} = $break{$_};	# Cannot be done before the file is around
+  }
+}
+
 sub dumpit {
     local ($savout) = select($OUT);
     do 'dumpvar.pl' unless defined &main::dumpValue;
     if (defined &main::dumpValue) {
+        local $frame = 0;
 	&main::dumpValue(shift);
     } else {
 	print $OUT "dumpvar.pl not available.\n";
@@ -852,6 +971,7 @@ sub system {
 }
 
 sub setterm {
+    local $frame = 0;
     eval "require Term::ReadLine;" or die $@;
     if ($notty) {
 	if ($tty) {
@@ -882,9 +1002,20 @@ sub setterm {
     $LINEINFO = $OUT unless defined $LINEINFO;
     $lineinfo = $console unless defined $lineinfo;
     $term->MinLine(2);
+    if ($term->Features->{setHistory} and "@hist" ne "?") {
+      $term->SetHistory(@hist);
+    }
 }
 
 sub readline {
+  if (@typeahead) {
+    my $left = @typeahead;
+    my $got = shift @typeahead;
+    print $OUT "auto(-$left)", shift, $got, "\n";
+    $term->AddHistory($got) 
+      if length($got) > 1 and defined $term->Features->{addHistory};
+    return $got;
+  }
   local $frame = 0;
   $term->readline(@_);
 }
@@ -939,7 +1070,7 @@ sub parse_options {
 	print $OUT "Unknown option `$opt'\n" unless $matches;
 	print $OUT "Ambiguous option `$opt'\n" if $matches > 1;
 	$option{$option} = $val if $matches == 1 and defined $val;
-	eval "require '$optionRequire{$option}'"
+	eval "local \$frame = 0; require '$optionRequire{$option}'"
 	  if $matches == 1 and defined $optionRequire{$option} and defined $val;
 	$ {$optionVars{$option}} = $val 
 	  if $matches == 1
@@ -953,6 +1084,31 @@ sub parse_options {
     }
 }
 
+sub set_list {
+  my ($stem,@list) = @_;
+  my $val;
+  $ENV{"$ {stem}_n"} = @list;
+  for $i (0 .. $#list) {
+    $val = $list[$i];
+    $val =~ s/\\/\\\\/g;
+    $val =~ s/[\0-\37\177\200-\377]/"\\0x" . unpack('H2',$&)/eg;
+    $ENV{"$ {stem}_$i"} = $val;
+  }
+}
+
+sub get_list {
+  my $stem = shift;
+  my @list;
+  my $n = delete $ENV{"$ {stem}_n"};
+  my $val;
+  for $i (0 .. $n - 1) {
+    $val = delete $ENV{"$ {stem}_$i"};
+    $val =~ s/\\((\\)|0x(..))/ $2 ? $2 : pack('H2', $3) /ge;
+    push @list, $val;
+  }
+  @list;
+}
+
 sub catch {
     $signal = 1;
 }
@@ -1060,10 +1216,11 @@ l subname	List first window of lines from subroutine.
 l		List next window of lines.
 -		List previous window of lines.
 w [line]	List window around line.
+.		Return to the executed line.
 f filename	Switch to viewing filename.
 /pattern/	Search forwards for pattern; final / is optional.
 ?pattern?	Search backwards for pattern; final ? is optional.
-L		List all breakpoints and actions.
+L		List all breakpoints and actions for the current file.
 S [[!]pattern]	List subroutine names [not] matching pattern.
 t		Toggle trace mode.
 t expr		Trace through execution of expr.
@@ -1118,6 +1275,8 @@ p expr		Same as \"print DB::OUT expr\" in current package.
 ||dbcmd		Same as |dbcmd but DB::OUT is temporarilly select()ed as well.
 \= [alias value]	Define a command alias, or list current aliases.
 command		Execute as a perl statement in current package.
+R		Pure-man-restart of debugger, debugger state and command-line
+		options are lost.
 h [db_command]	Get help [on a specific debugger command], enter |h to page.
 h h		Summary of debugger commands.
 q or ^D		Quit.
@@ -1126,7 +1285,7 @@ q or ^D		Quit.
     $summary = <<"END_SUM";
 List/search source lines:               Control script execution:
   l [ln|sub]  List source code            T           Stack trace
-  -           List previous lines         s [expr]    Single step [in expr]
+  - or .      List previous/current line  s [expr]    Single step [in expr]
   w [line]    List around line            n [expr]    Next, steps over subs
   f filename  View source in file         <CR>        Repeat last n or s
   /pattern/   Search forward              r           Return from subroutine
@@ -1140,7 +1299,7 @@ Debugger controls:                        L           List break pts & actions
   = [a val]   Define/list an alias        a [ln] cmd  Do cmd before line
   h [db_cmd]  Get help on command         A           Delete all actions
   |[|]dbcmd   Send output to pager        $psh\[$psh\] syscmd Run cmd in a subprocess
-  q or ^D     Quit
+  q or ^D     Quit			  R	      Attempt a restart
 Data Examination:	      expr     Execute perl code, also see: s,n,t expr
   S [[!]pat]	List subroutine names [not] matching pattern
   V [Pk [Vars]]	List Variables in Package.  Vars can be ~pattern or !pattern.
@@ -1151,8 +1310,8 @@ END_SUM
 				# '); # Fix balance of Emacs parsing
 }
 
-
 sub diesignal {
+    local $frame = 0;
     $SIG{'ABRT'} = DEFAULT;
     kill 'ABRT', $$ if $panic++;
     print $DB::OUT "Got $_[0]!\n";	# in the case cannot continue
@@ -1164,6 +1323,7 @@ sub diesignal {
 }
 
 sub dbwarn { 
+  local $frame = 0;
   local $SIG{__WARN__} = '';
   require Carp; 
   #&warn("Entering dbwarn\n");
@@ -1177,6 +1337,7 @@ sub dbwarn {
 }
 
 sub dbdie {
+  local $frame = 0;
   local $SIG{__DIE__} = '';
   local $SIG{__WARN__} = '';
   my $i = 0; my $ineval = 0; my $sub;
@@ -1203,18 +1364,6 @@ sub dbdie {
   die $mess;
 }
 
-# sub diehard {			# Always dump, useful if fatal is
-#                                 # deeply in evals.
-#   local $SIG{__DIE__} = '';
-#   require Carp; 
-#   # We do not want to debug this (automatic disabling works inside DB::DB)
-#   my ($mysingle,$mytrace) = ($single,$trace);
-#   $single = 0; $trace = 0;
-#   my $mess = Carp::longmess(@_);
-#   ($single,$trace) = ($mysingle,$mytrace);
-#   die $mess;
-# }
-
 sub warnLevel {
   if (@_) {
     $prevwarn = $SIG{__WARN__} unless $warnLevel;
@@ -1290,6 +1439,8 @@ BEGIN {			# This does not compile, alas.
   $level = 0;			# Level of recursive debugging
 }
 
+BEGIN {$^W = $ini_warn;}	# Switch warnings back
+
 #use Carp;			# This did break, left for debuggin
 
 1;