Re: Debugger in beta3
authorIlya Zakharevich <ilya@math.ohio-state.edu>
Tue, 6 Feb 1996 20:32:09 +0000 (15:32 -0500)
committerAndy Dougherty <doughera@lafcol.lafayette.edu>
Tue, 6 Feb 1996 20:32:09 +0000 (15:32 -0500)
lib/dumpvar.pl
lib/perl5db.pl

index c78319b..06c0930 100644 (file)
@@ -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;
index 711003a..5c8d272 100644 (file)
@@ -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;