This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fix `l $var` where $var is a lexical variable
authorTony Cook <tony@develop-help.com>
Tue, 31 Mar 2020 05:45:04 +0000 (16:45 +1100)
committerTony Cook <tony@develop-help.com>
Mon, 10 Aug 2020 04:47:53 +0000 (04:47 +0000)
As with `i $obj` the DB::Obj in the call stack prevented DB::eval
from compiling/executing in the context of the debugged code.

MANIFEST
lib/perl5db.pl
lib/perl5db.t
lib/perl5db/t/gh-17661b [new file with mode: 0644]

index 96af361..7aca709 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -4809,6 +4809,7 @@ lib/perl5db/t/fact                Tests for the Perl debugger
 lib/perl5db/t/filename-line-breakpoint         Tests for the Perl debugger
 lib/perl5db/t/gh-17660         Tests for the Perl debugger
 lib/perl5db/t/gh-17661         Tests for the Perl debugger
+lib/perl5db/t/gh-17661b                Tests for the Perl debugger
 lib/perl5db/t/load-modules     Tests for the Perl debugger
 lib/perl5db/t/lsub-n           Test script used by perl5db.t
 lib/perl5db/t/lvalue-bug       Tests for the Perl debugger
index b647d24..065fa85 100644 (file)
@@ -2543,3234 +2543,3237 @@ sub _DB__handle_i_command {
     next CMD;
 }
 
-# 't' is type.
-# 'm' is method.
-# 'v' is the value (i.e: method name or subroutine ref).
-# 's' is subroutine.
-my %cmd_lookup;
+=head3 C<cmd_l> - list lines (command)
 
-BEGIN
-{
-    %cmd_lookup =
-(
-    '-' => { t => 'm', v => '_handle_dash_command', },
-    '.' => { t => 's', v => \&_DB__handle_dot_command, },
-    '=' => { t => 'm', v => '_handle_equal_sign_command', },
-    'H' => { t => 'm', v => '_handle_H_command', },
-    'S' => { t => 'm', v => '_handle_S_command', },
-    'T' => { t => 'm', v => '_handle_T_command', },
-    'W' => { t => 'm', v => '_handle_W_command', },
-    'c' => { t => 's', v => \&_DB__handle_c_command, },
-    'f' => { t => 's', v => \&_DB__handle_f_command, },
-    'i' => { t => 's', v => \&_DB__handle_i_command, },
-    'm' => { t => 's', v => \&_DB__handle_m_command, },
-    'n' => { t => 'm', v => '_handle_n_command', },
-    'p' => { t => 'm', v => '_handle_p_command', },
-    'q' => { t => 'm', v => '_handle_q_command', },
-    'r' => { t => 'm', v => '_handle_r_command', },
-    's' => { t => 'm', v => '_handle_s_command', },
-    'save' => { t => 'm', v => '_handle_save_command', },
-    'source' => { t => 'm', v => '_handle_source_command', },
-    't' => { t => 'm', v => '_handle_t_command', },
-    'w' => { t => 'm', v => '_handle_w_command', },
-    'x' => { t => 'm', v => '_handle_x_command', },
-    'y' => { t => 's', v => \&_DB__handle_y_command, },
-    (map { $_ => { t => 'm', v => '_handle_V_command_and_X_command', }, }
-        ('X', 'V')),
-    (map { $_ => { t => 'm', v => '_handle_enable_disable_commands', }, }
-        qw(enable disable)),
-    (map { $_ =>
-        { t => 's', v => \&_DB__handle_restart_and_rerun_commands, },
-        } qw(R rerun)),
-    (map { $_ => {t => 'm', v => '_handle_cmd_wrapper_commands' }, }
-        qw(a A b B e E h l L M o O v w W)),
-);
-};
+Most of the command is taken up with transforming all the different line
+specification syntaxes into 'start-stop'. After that is done, the command
+runs a loop over C<@dbline> for the specified range of lines. It handles
+the printing of each line and any markers (C<==E<gt>> for current line,
+C<b> for break on this line, C<a> for action on this line, C<:> for this
+line breakable).
 
-sub DB {
+We save the last line listed in the C<$start> global for further listing
+later.
 
-    # lock the debugger and get the thread id for the prompt
-    lock($DBGR);
-    my $tid;
-    my $position;
-    my ($prefix, $after, $infix);
-    my $pat;
-    my $explicit_stop;
-    my $piped;
-    my $selected;
+=cut
 
-    if ($ENV{PERL5DB_THREADED}) {
-        $tid = eval { "[".threads->tid."]" };
+sub _min {
+    my $min = shift;
+    foreach my $v (@_) {
+        if ($min > $v) {
+            $min = $v;
+        }
     }
+    return $min;
+}
 
-    my $cmd_verb;
-    my $cmd_args;
+sub _max {
+    my $max = shift;
+    foreach my $v (@_) {
+        if ($max < $v) {
+            $max = $v;
+        }
+    }
+    return $max;
+}
 
-    my $obj = DB::Obj->new(
-        {
-            position => \$position,
-            prefix => \$prefix,
-            after => \$after,
-            explicit_stop => \$explicit_stop,
-            infix => \$infix,
-            cmd_args => \$cmd_args,
-            cmd_verb => \$cmd_verb,
-            pat => \$pat,
-            piped => \$piped,
-            selected => \$selected,
-        },
-    );
+sub _minify_to_max {
+    my $ref = shift;
 
-    $obj->_DB_on_init__initialize_globals(@_);
+    $$ref = _min($$ref, $max);
 
-    # Preserve current values of $@, $!, $^E, $,, $/, $\, $^W.
-    # The code being debugged may have altered them.
-    DB::save();
+    return;
+}
 
-    # Since DB::DB gets called after every line, we can use caller() to
-    # figure out where we last were executing. Sneaky, eh? This works because
-    # caller is returning all the extra information when called from the
-    # debugger.
-    local ( $package, $filename, $line ) = caller;
-    $filename_ini = $filename;
+sub _cmd_l_handle_var_name {
+    my $var_name = shift;
 
-    # set up the context for DB::eval, so it can properly execute
-    # code on behalf of the user. We add the package in so that the
-    # code is eval'ed in the proper package (not in the debugger!).
-    local $usercontext = _calc_usercontext($package);
+    $evalarg = $var_name;
 
-    # Create an alias to the active file magical array to simplify
-    # the code here.
-    local (*dbline) = $main::{ '_<' . $filename };
+    my ($s) = DB::eval();
 
-    # Last line in the program.
-    $max = $#dbline;
+    # Ooops. Bad scalar.
+    if ($@) {
+        print {$OUT} "Error: $@\n";
+        next CMD;
+    }
 
-    # The &-call is here to ascertain the mutability of @_.
-    &_DB__determine_if_we_should_break;
+    # Good scalar. If it's a reference, find what it points to.
+    $s = CvGV_name($s);
+    print {$OUT} "Interpreted as: $1 $s\n";
+    $line = "$1 $s";
 
-    # Preserve the current stop-or-not, and see if any of the W
-    # (watch expressions) has changed.
-    my $was_signal = $signal;
+    # Call self recursively to really do the command.
+    return _cmd_l_main( $s );
+}
 
-    # If we have any watch expressions ...
-    _DB__handle_watch_expressions($obj);
+sub _cmd_l_handle_subname {
 
-=head2 C<watchfunction()>
+    my $s = $subname;
 
-C<watchfunction()> is a function that can be defined by the user; it is a
-function which will be run on each entry to C<DB::DB>; it gets the
-current package, filename, and line as its parameters.
+    # De-Perl4.
+    $subname =~ s/\'/::/;
 
-The watchfunction can do anything it likes; it is executing in the
-debugger's context, so it has access to all of the debugger's internal
-data structures and functions.
+    # Put it in this package unless it starts with ::.
+    $subname = $package . "::" . $subname unless $subname =~ /::/;
 
-C<watchfunction()> can control the debugger's actions. Any of the following
-will cause the debugger to return control to the user's program after
-C<watchfunction()> executes:
+    # Put it in CORE::GLOBAL if t doesn't start with :: and
+    # it doesn't live in this package and it lives in CORE::GLOBAL.
+    $subname = "CORE::GLOBAL::$s"
+    if not defined &$subname
+        and $s !~ /::/
+        and defined &{"CORE::GLOBAL::$s"};
 
-=over 4
+    # Put leading '::' names into 'main::'.
+    $subname = "main" . $subname if substr( $subname, 0, 2 ) eq "::";
 
-=item *
+    # Get name:start-stop from find_sub, and break this up at
+    # colons.
+    my @pieces = split( /:/, find_sub($subname) || $sub{$subname} );
 
-Returning a false value from the C<watchfunction()> itself.
+    # Pull off start-stop.
+    my $subrange = pop @pieces;
 
-=item *
+    # If the name contained colons, the split broke it up.
+    # Put it back together.
+    $file = join( ':', @pieces );
 
-Altering C<$single> to a false value.
+    # If we're not in that file, switch over to it.
+    if ( $file ne $filename ) {
+        if (! $slave_editor) {
+            print {$OUT} "Switching to file '$file'.\n";
+        }
 
-=item *
+        # Switch debugger's magic structures.
+        *dbline   = $main::{ '_<' . $file };
+        $max      = $#dbline;
+        $filename = $file;
+    } ## end if ($file ne $filename)
 
-Altering C<$signal> to a false value.
+    # Subrange is 'start-stop'. If this is less than a window full,
+    # swap it to 'start+', which will list a window from the start point.
+    if ($subrange) {
+        if ( eval($subrange) < -$window ) {
+            $subrange =~ s/-.*/+/;
+        }
 
-=item *
+        # Call self recursively to list the range.
+        return _cmd_l_main( $subrange );
+    } ## end if ($subrange)
 
-Turning off the C<4> bit in C<$trace> (this also disables the
-check for C<watchfunction()>. This can be done with
+    # Couldn't find it.
+    else {
+        print {$OUT} "Subroutine $subname not found.\n";
+        return;
+    }
+}
 
-    $trace &= ~4;
+sub _cmd_l_empty {
+    # Compute new range to list.
+    $incr = $window - 1;
 
-=back
+    # Recurse to do it.
+    return _cmd_l_main( $start . '-' . ( $start + $incr ) );
+}
 
-=cut
+sub _cmd_l_plus {
+    my ($new_start, $new_incr) = @_;
 
-    # If there's a user-defined DB::watchfunction, call it with the
-    # current package, filename, and line. The function executes in
-    # the DB:: package.
-    if ( $trace & 4 ) {    # User-installed watch
-        return
-          if watchfunction( $package, $filename, $line )
-          and not $single
-          and not $was_signal
-          and not( $trace & ~4 );
-    } ## end if ($trace & 4)
+    # Don't reset start for 'l +nnn'.
+    $start = $new_start if $new_start;
 
-    # Pick up any alteration to $signal in the watchfunction, and
-    # turn off the signal now.
-    $was_signal = $signal;
-    $signal     = 0;
+    # Increment for list. Use window size if not specified.
+    # (Allows 'l +' to work.)
+    $incr = $new_incr || ($window - 1);
 
-=head2 GETTING READY TO EXECUTE COMMANDS
+    # Create a line range we'll understand, and recurse to do it.
+    return _cmd_l_main( $start . '-' . ( $start + $incr ) );
+}
 
-The debugger decides to take control if single-step mode is on, the
-C<t> command was entered, or the user generated a signal. If the program
-has fallen off the end, we set things up so that entering further commands
-won't cause trouble, and we say that the program is over.
+sub _cmd_l_calc_initial_end_and_i {
+    my ($spec, $start_match, $end_match) = @_;
 
-=cut
+    # Determine end point; use end of file if not specified.
+    my $end = ( !defined $start_match ) ? $max :
+    ( $end_match ? $end_match : $start_match );
 
-    # Make sure that we always print if asked for explicitly regardless
-    # of $trace_to_depth .
-    $explicit_stop = ($single || $was_signal);
-
-    # Check to see if we should grab control ($single true,
-    # trace set appropriately, or we got a signal).
-    if ( $explicit_stop || ( $trace & 1 ) ) {
-        $obj->_DB__grab_control(@_);
-    } ## end if ($single || ($trace...
-
-=pod
-
-If there's an action to be executed for the line we stopped at, execute it.
-If there are any preprompt actions, execute those as well.
+    # Go on to the end, and then stop.
+    _minify_to_max(\$end);
 
-=cut
+    # Determine start line.
+    my $i = $start_match;
 
-    # If there's an action, do it now.
-    if ($action) {
-        $evalarg = $action;
-        # The &-call is here to ascertain the mutability of @_.
-        &DB::eval;
+    if ($i eq '.') {
+        $i = $spec;
     }
-    undef $action;
-
-    # Are we nested another level (e.g., did we evaluate a function
-    # that had a breakpoint in it at the debugger prompt)?
-    if ( $single || $was_signal ) {
-
-        # Yes, go down a level.
-        local $level = $level + 1;
-
-        # Do any pre-prompt actions.
-        foreach $evalarg (@$pre) {
-            # The &-call is here to ascertain the mutability of @_.
-            &DB::eval;
-        }
-
-        # Complain about too much recursion if we passed the limit.
-        if ($single & 4) {
-            print $OUT $stack_depth . " levels deep in subroutine calls!\n";
-        }
-
-        # The line we're currently on. Set $incr to -1 to stay here
-        # until we get a command that tells us to advance.
-        $start = $line;
-        $incr  = -1;      # for backward motion.
-
-        # Tack preprompt debugger actions ahead of any actual input.
-        @typeahead = ( @$pretype, @typeahead );
-
-=head2 WHERE ARE WE?
-
-XXX Relocate this section?
-
-The debugger normally shows the line corresponding to the current line of
-execution. Sometimes, though, we want to see the next line, or to move elsewhere
-in the file. This is done via the C<$incr>, C<$start>, and C<$max> variables.
-
-C<$incr> controls by how many lines the I<current> line should move forward
-after a command is executed. If set to -1, this indicates that the I<current>
-line shouldn't change.
-
-C<$start> is the I<current> line. It is used for things like knowing where to
-move forwards or backwards from when doing an C<L> or C<-> command.
-
-C<$max> tells the debugger where the last line of the current file is. It's
-used to terminate loops most often.
-
-=head2 THE COMMAND LOOP
-
-Most of C<DB::DB> is actually a command parsing and dispatch loop. It comes
-in two parts:
-
-=over 4
-
-=item *
-
-The outer part of the loop, starting at the C<CMD> label. This loop
-reads a command and then executes it.
-
-=item *
-
-The inner part of the loop, starting at the C<PIPE> label. This part
-is wholly contained inside the C<CMD> block and only executes a command.
-Used to handle commands running inside a pager.
-
-=back
-
-So why have two labels to restart the loop? Because sometimes, it's easier to
-have a command I<generate> another command and then re-execute the loop to do
-the new command. This is faster, but perhaps a bit more convoluted.
 
-=cut
+    $i = _max($i, 1);
 
-        # The big command dispatch loop. It keeps running until the
-        # user yields up control again.
-        #
-        # If we have a terminal for input, and we get something back
-        # from readline(), keep on processing.
+    $incr = $end - $i;
 
-      CMD:
-        while (_DB__read_next_cmd($tid))
-        {
+    return ($end, $i);
+}
 
-            share($cmd);
-            # ... try to execute the input as debugger commands.
+sub _cmd_l_range {
+    my ($spec, $current_line, $start_match, $end_match) = @_;
 
-            # Don't stop running.
-            $single = 0;
+    my ($end, $i) =
+        _cmd_l_calc_initial_end_and_i($spec, $start_match, $end_match);
 
-            # No signal is active.
-            $signal = 0;
+    # If we're running under a slave editor, force it to show the lines.
+    if ($slave_editor) {
+        print {$OUT} "\032\032$filename:$i:0\n";
+        $i = $end;
+    }
+    # We're doing it ourselves. We want to show the line and special
+    # markers for:
+    # - the current line in execution
+    # - whether a line is breakable or not
+    # - whether a line has a break or not
+    # - whether a line has an action or not
+    else {
+        I_TO_END:
+        for ( ; $i <= $end ; $i++ ) {
 
-            # Handle continued commands (ending with \):
-            if ($cmd =~ s/\\\z/\n/) {
-                $cmd .= DB::readline("  cont: ");
-                redo CMD;
+            # Check for breakpoints and actions.
+            my ( $stop, $action );
+            if ($dbline{$i}) {
+                ( $stop, $action ) = split( /\0/, $dbline{$i} );
             }
 
-=head4 The null command
+            # ==> if this is the current line in execution,
+            # : if it's breakable.
+            my $arrow =
+            ( $i == $current_line and $filename eq $filename_ini )
+            ? '==>'
+            : ( $dbline[$i] + 0 ? ':' : ' ' );
 
-A newline entered by itself means I<re-execute the last command>. We grab the
-command out of C<$laststep> (where it was recorded previously), and copy it
-back into C<$cmd> to be executed below. If there wasn't any previous command,
-we'll do nothing below (no command will match). If there was, we also save it
-in the command history and fall through to allow the command parsing to pick
-it up.
+            # Add break and action indicators.
+            $arrow .= 'b' if $stop;
+            $arrow .= 'a' if $action;
 
-=cut
+            # Print the line.
+            print {$OUT} "$i$arrow\t", $dbline[$i];
 
-            # Empty input means repeat the last command.
-            if ($cmd eq '') {
-                $cmd = $laststep;
-            }
-            chomp($cmd);    # get rid of the annoying extra newline
-            if (length($cmd) >= option_val('HistItemMinLength', 2)) {
-                push( @hist, $cmd );
+            # Move on to the next line. Drop out on an interrupt.
+            if ($signal) {
+                $i++;
+                last I_TO_END;
             }
-            push( @truehist, $cmd );
-            share(@hist);
-            share(@truehist);
-
-            # This is a restart point for commands that didn't arrive
-            # via direct user input. It allows us to 'redo PIPE' to
-            # re-execute command processing without reading a new command.
-          PIPE: {
-                _DB__trim_command_and_return_first_component($obj);
-
-=head3 COMMAND ALIASES
-
-The debugger can create aliases for commands (these are stored in the
-C<%alias> hash). Before a command is executed, the command loop looks it up
-in the alias hash and substitutes the contents of the alias for the command,
-completely replacing it.
-
-=cut
-
-                # See if there's an alias for the command, and set it up if so.
-                if ( $alias{$cmd_verb} ) {
-
-                    # Squelch signal handling; we want to keep control here
-                    # if something goes loco during the alias eval.
-                    local $SIG{__DIE__};
-                    local $SIG{__WARN__};
-
-                    # This is a command, so we eval it in the DEBUGGER's
-                    # scope! Otherwise, we can't see the special debugger
-                    # variables, or get to the debugger's subs. (Well, we
-                    # _could_, but why make it even more complicated?)
-                    eval "\$cmd =~ $alias{$cmd_verb}";
-                    if ($@) {
-                        local $\ = '';
-                        print $OUT "Couldn't evaluate '$cmd_verb' alias: $@";
-                        next CMD;
-                    }
-                    _DB__trim_command_and_return_first_component($obj);
-                } ## end if ($alias{$cmd_verb})
-
-=head3 MAIN-LINE COMMANDS
-
-All of these commands work up to and after the program being debugged has
-terminated.
-
-=head4 C<q> - quit
-
-Quit the debugger. This entails setting the C<$fall_off_end> flag, so we don't
-try to execute further, cleaning any restart-related stuff out of the
-environment, and executing with the last value of C<$?>.
-
-=cut
-
-                # All of these commands were remapped in perl 5.8.0;
-                # we send them off to the secondary dispatcher (see below).
-                $obj->_handle_special_char_cmd_wrapper_commands;
-                _DB__trim_command_and_return_first_component($obj);
-
-                if (my $cmd_rec = $cmd_lookup{$cmd_verb}) {
-                    my $type = $cmd_rec->{t};
-                    my $val = $cmd_rec->{v};
-                    if ($type eq 'm') {
-                        $obj->$val();
-                    }
-                    elsif ($type eq 's') {
-                        $val->($obj);
-                    }
-                }
-
-=head4 C<t> - trace [n]
-
-Turn tracing on or off. Inverts the appropriate bit in C<$trace> (q.v.).
-If level is specified, set C<$trace_to_depth>.
-
-=head4 C<S> - list subroutines matching/not matching a pattern
-
-Walks through C<%sub>, checking to see whether or not to print the name.
-
-=head4 C<X> - list variables in current package
-
-Since the C<V> command actually processes this, just change this to the
-appropriate C<V> command and fall through.
-
-=head4 C<V> - list variables
-
-Uses C<dumpvar.pl> to dump out the current values for selected variables.
-
-=head4 C<x> - evaluate and print an expression
-
-Hands the expression off to C<DB::eval>, setting it up to print the value
-via C<dumpvar.pl> instead of just printing it directly.
-
-=head4 C<m> - print methods
+        } ## end for (; $i <= $end ; $i++)
 
-Just uses C<DB::methods> to determine what methods are available.
+        # Line the prompt up; print a newline if the last line listed
+        # didn't have a newline.
+        if ($dbline[ $i - 1 ] !~ /\n\z/) {
+            print {$OUT} "\n";
+        }
+    } ## end else [ if ($slave_editor)
 
-=head4 C<f> - switch files
+    # Save the point we last listed to in case another relative 'l'
+    # command is desired. Don't let it run off the end.
+    $start = $i;
+    _minify_to_max(\$start);
 
-Switch to a different filename.
+    return;
+}
 
-=head4 C<.> - return to last-executed line.
+sub _cmd_l_main {
+    my $spec = shift;
 
-We set C<$incr> to -1 to indicate that the debugger shouldn't move ahead,
-and then we look up the line in the magical C<%dbline> hash.
+    # If this is '-something', delete any spaces after the dash.
+    $spec =~ s/\A-\s*\z/-/;
 
-=head4 C<-> - back one window
+    # If the line is '$something', assume this is a scalar containing a
+    # line number.
+    # Set up for DB::eval() - evaluate in *user* context.
+    if ( my ($var_name) = $spec =~ /\A(\$.*)/s ) {
+        return _cmd_l_handle_var_name($var_name);
+    }
+    # l name. Try to find a sub by that name.
+    elsif ( ($subname) = $spec =~ /\A([\':A-Za-z_][\':\w]*(?:\[.*\])?)/s ) {
+        return _cmd_l_handle_subname();
+    }
+    # Bare 'l' command.
+    elsif ( $spec !~ /\S/ ) {
+        return _cmd_l_empty();
+    }
+    # l [start]+number_of_lines
+    elsif ( my ($new_start, $new_incr) = $spec =~ /\A(\d*)\+(\d*)\z/ ) {
+        return _cmd_l_plus($new_start, $new_incr);
+    }
+    # l start-stop or l start,stop
+    elsif (my ($s, $e) = $spec =~ /^(?:(-?[\d\$\.]+)(?:[-,]([\d\$\.]+))?)?/ ) {
+        return _cmd_l_range($spec, $line, $s, $e);
+    }
 
-We change C<$start> to be one window back; if we go back past the first line,
-we set it to be the first line. We set C<$incr> to put us back at the
-currently-executing line, and then put a C<l $start +> (list one window from
-C<$start>) in C<$cmd> to be executed later.
+    return;
+} ## end sub cmd_l
 
-=head3 PRE-580 COMMANDS VS. NEW COMMANDS: C<a, A, b, B, h, l, L, M, o, O, P, v, w, W, E<lt>, E<lt>E<lt>, E<0x7B>, E<0x7B>E<0x7B>>
+sub _DB__handle_l_command {
+    my $self = shift;
 
-In Perl 5.8.0, a realignment of the commands was done to fix up a number of
-problems, most notably that the default case of several commands destroying
-the user's work in setting watchpoints, actions, etc. We wanted, however, to
-retain the old commands for those who were used to using them or who preferred
-them. At this point, we check for the new commands and call C<cmd_wrapper> to
-deal with them instead of processing them in-line.
+    _cmd_l_main($self->cmd_args);
+    next CMD;
+}
 
-=head4 C<y> - List lexicals in higher scope
 
-Uses C<PadWalker> to find the lexicals supplied as arguments in a scope
-above the current one and then displays then using C<dumpvar.pl>.
+# 't' is type.
+# 'm' is method.
+# 'v' is the value (i.e: method name or subroutine ref).
+# 's' is subroutine.
+my %cmd_lookup;
 
-=head3 COMMANDS NOT WORKING AFTER PROGRAM ENDS
+BEGIN
+{
+    %cmd_lookup =
+(
+    '-' => { t => 'm', v => '_handle_dash_command', },
+    '.' => { t => 's', v => \&_DB__handle_dot_command, },
+    '=' => { t => 'm', v => '_handle_equal_sign_command', },
+    'H' => { t => 'm', v => '_handle_H_command', },
+    'S' => { t => 'm', v => '_handle_S_command', },
+    'T' => { t => 'm', v => '_handle_T_command', },
+    'W' => { t => 'm', v => '_handle_W_command', },
+    'c' => { t => 's', v => \&_DB__handle_c_command, },
+    'f' => { t => 's', v => \&_DB__handle_f_command, },
+    'i' => { t => 's', v => \&_DB__handle_i_command, },
+    'l' => { t => 's', v => \&_DB__handle_l_command, },
+    'm' => { t => 's', v => \&_DB__handle_m_command, },
+    'n' => { t => 'm', v => '_handle_n_command', },
+    'p' => { t => 'm', v => '_handle_p_command', },
+    'q' => { t => 'm', v => '_handle_q_command', },
+    'r' => { t => 'm', v => '_handle_r_command', },
+    's' => { t => 'm', v => '_handle_s_command', },
+    'save' => { t => 'm', v => '_handle_save_command', },
+    'source' => { t => 'm', v => '_handle_source_command', },
+    't' => { t => 'm', v => '_handle_t_command', },
+    'w' => { t => 'm', v => '_handle_w_command', },
+    'x' => { t => 'm', v => '_handle_x_command', },
+    'y' => { t => 's', v => \&_DB__handle_y_command, },
+    (map { $_ => { t => 'm', v => '_handle_V_command_and_X_command', }, }
+        ('X', 'V')),
+    (map { $_ => { t => 'm', v => '_handle_enable_disable_commands', }, }
+        qw(enable disable)),
+    (map { $_ =>
+        { t => 's', v => \&_DB__handle_restart_and_rerun_commands, },
+        } qw(R rerun)),
+    (map { $_ => {t => 'm', v => '_handle_cmd_wrapper_commands' }, }
+        qw(a A b B e E h L M o O v w W)),
+);
+};
 
-All of the commands below this point don't work after the program being
-debugged has ended. All of them check to see if the program has ended; this
-allows the commands to be relocated without worrying about a 'line of
-demarcation' above which commands can be entered anytime, and below which
-they can't.
+sub DB {
 
-=head4 C<n> - single step, but don't trace down into subs
+    # lock the debugger and get the thread id for the prompt
+    lock($DBGR);
+    my $tid;
+    my $position;
+    my ($prefix, $after, $infix);
+    my $pat;
+    my $explicit_stop;
+    my $piped;
+    my $selected;
 
-Done by setting C<$single> to 2, which forces subs to execute straight through
-when entered (see C<DB::sub>). We also save the C<n> command in C<$laststep>,
-so a null command knows what to re-execute.
+    if ($ENV{PERL5DB_THREADED}) {
+        $tid = eval { "[".threads->tid."]" };
+    }
 
-=head4 C<s> - single-step, entering subs
+    my $cmd_verb;
+    my $cmd_args;
 
-Sets C<$single> to 1, which causes C<DB::sub> to continue tracing inside
-subs. Also saves C<s> as C<$lastcmd>.
+    my $obj = DB::Obj->new(
+        {
+            position => \$position,
+            prefix => \$prefix,
+            after => \$after,
+            explicit_stop => \$explicit_stop,
+            infix => \$infix,
+            cmd_args => \$cmd_args,
+            cmd_verb => \$cmd_verb,
+            pat => \$pat,
+            piped => \$piped,
+            selected => \$selected,
+        },
+    );
 
-=head4 C<c> - run continuously, setting an optional breakpoint
+    $obj->_DB_on_init__initialize_globals(@_);
 
-Most of the code for this command is taken up with locating the optional
-breakpoint, which is either a subroutine name or a line number. We set
-the appropriate one-time-break in C<@dbline> and then turn off single-stepping
-in this and all call levels above this one.
+    # Preserve current values of $@, $!, $^E, $,, $/, $\, $^W.
+    # The code being debugged may have altered them.
+    DB::save();
 
-=head4 C<r> - return from a subroutine
+    # Since DB::DB gets called after every line, we can use caller() to
+    # figure out where we last were executing. Sneaky, eh? This works because
+    # caller is returning all the extra information when called from the
+    # debugger.
+    local ( $package, $filename, $line ) = caller;
+    $filename_ini = $filename;
 
-For C<r> to work properly, the debugger has to stop execution again
-immediately after the return is executed. This is done by forcing
-single-stepping to be on in the call level above the current one. If
-we are printing return values when a C<r> is executed, set C<$doret>
-appropriately, and force us out of the command loop.
+    # set up the context for DB::eval, so it can properly execute
+    # code on behalf of the user. We add the package in so that the
+    # code is eval'ed in the proper package (not in the debugger!).
+    local $usercontext = _calc_usercontext($package);
 
-=head4 C<T> - stack trace
+    # Create an alias to the active file magical array to simplify
+    # the code here.
+    local (*dbline) = $main::{ '_<' . $filename };
 
-Just calls C<DB::print_trace>.
+    # Last line in the program.
+    $max = $#dbline;
 
-=head4 C<w> - List window around current line.
+    # The &-call is here to ascertain the mutability of @_.
+    &_DB__determine_if_we_should_break;
 
-Just calls C<DB::cmd_w>.
+    # Preserve the current stop-or-not, and see if any of the W
+    # (watch expressions) has changed.
+    my $was_signal = $signal;
 
-=head4 C<W> - watch-expression processing.
+    # If we have any watch expressions ...
+    _DB__handle_watch_expressions($obj);
 
-Just calls C<DB::cmd_W>.
+=head2 C<watchfunction()>
 
-=head4 C</> - search forward for a string in the source
+C<watchfunction()> is a function that can be defined by the user; it is a
+function which will be run on each entry to C<DB::DB>; it gets the
+current package, filename, and line as its parameters.
 
-We take the argument and treat it as a pattern. If it turns out to be a
-bad one, we return the error we got from trying to C<eval> it and exit.
-If not, we create some code to do the search and C<eval> it so it can't
-mess us up.
+The watchfunction can do anything it likes; it is executing in the
+debugger's context, so it has access to all of the debugger's internal
+data structures and functions.
 
-=cut
+C<watchfunction()> can control the debugger's actions. Any of the following
+will cause the debugger to return control to the user's program after
+C<watchfunction()> executes:
 
-                _DB__handle_forward_slash_command($obj);
+=over 4
 
-=head4 C<?> - search backward for a string in the source
+=item *
 
-Same as for C</>, except the loop runs backwards.
+Returning a false value from the C<watchfunction()> itself.
 
-=cut
+=item *
 
-                _DB__handle_question_mark_command($obj);
+Altering C<$single> to a false value.
 
-=head4 C<$rc> - Recall command
+=item *
 
-Manages the commands in C<@hist> (which is created if C<Term::ReadLine> reports
-that the terminal supports history). It finds the command required, puts it
-into C<$cmd>, and redoes the loop to execute it.
+Altering C<$signal> to a false value.
 
-=cut
+=item *
 
-                # $rc - recall command.
-                $obj->_handle_rc_recall_command;
+Turning off the C<4> bit in C<$trace> (this also disables the
+check for C<watchfunction()>. This can be done with
 
-=head4 C<$sh$sh> - C<system()> command
+    $trace &= ~4;
 
-Calls the C<_db_system()> to handle the command. This keeps the C<STDIN> and
-C<STDOUT> from getting messed up.
+=back
 
 =cut
 
-                $obj->_handle_sh_command;
-
-=head4 C<$rc I<pattern> $rc> - Search command history
-
-Another command to manipulate C<@hist>: this one searches it with a pattern.
-If a command is found, it is placed in C<$cmd> and executed via C<redo>.
-
-=cut
+    # If there's a user-defined DB::watchfunction, call it with the
+    # current package, filename, and line. The function executes in
+    # the DB:: package.
+    if ( $trace & 4 ) {    # User-installed watch
+        return
+          if watchfunction( $package, $filename, $line )
+          and not $single
+          and not $was_signal
+          and not( $trace & ~4 );
+    } ## end if ($trace & 4)
 
-                $obj->_handle_rc_search_history_command;
+    # Pick up any alteration to $signal in the watchfunction, and
+    # turn off the signal now.
+    $was_signal = $signal;
+    $signal     = 0;
 
-=head4 C<$sh> - Invoke a shell
+=head2 GETTING READY TO EXECUTE COMMANDS
 
-Uses C<_db_system()> to invoke a shell.
+The debugger decides to take control if single-step mode is on, the
+C<t> command was entered, or the user generated a signal. If the program
+has fallen off the end, we set things up so that entering further commands
+won't cause trouble, and we say that the program is over.
 
 =cut
 
-=head4 C<$sh I<command>> - Force execution of a command in a shell
+    # Make sure that we always print if asked for explicitly regardless
+    # of $trace_to_depth .
+    $explicit_stop = ($single || $was_signal);
 
-Like the above, but the command is passed to the shell. Again, we use
-C<_db_system()> to avoid problems with C<STDIN> and C<STDOUT>.
+    # Check to see if we should grab control ($single true,
+    # trace set appropriately, or we got a signal).
+    if ( $explicit_stop || ( $trace & 1 ) ) {
+        $obj->_DB__grab_control(@_);
+    } ## end if ($single || ($trace...
 
-=head4 C<H> - display commands in history
+=pod
 
-Prints the contents of C<@hist> (if any).
+If there's an action to be executed for the line we stopped at, execute it.
+If there are any preprompt actions, execute those as well.
 
-=head4 C<man, doc, perldoc> - look up documentation
+=cut
 
-Just calls C<runman()> to print the appropriate document.
+    # If there's an action, do it now.
+    if ($action) {
+        $evalarg = $action;
+        # The &-call is here to ascertain the mutability of @_.
+        &DB::eval;
+    }
+    undef $action;
 
-=cut
+    # Are we nested another level (e.g., did we evaluate a function
+    # that had a breakpoint in it at the debugger prompt)?
+    if ( $single || $was_signal ) {
 
-                $obj->_handle_doc_command;
+        # Yes, go down a level.
+        local $level = $level + 1;
 
-=head4 C<p> - print
+        # Do any pre-prompt actions.
+        foreach $evalarg (@$pre) {
+            # The &-call is here to ascertain the mutability of @_.
+            &DB::eval;
+        }
 
-Builds a C<print EXPR> expression in the C<$cmd>; this will get executed at
-the bottom of the loop.
+        # Complain about too much recursion if we passed the limit.
+        if ($single & 4) {
+            print $OUT $stack_depth . " levels deep in subroutine calls!\n";
+        }
 
-=head4 C<=> - define command alias
+        # The line we're currently on. Set $incr to -1 to stay here
+        # until we get a command that tells us to advance.
+        $start = $line;
+        $incr  = -1;      # for backward motion.
 
-Manipulates C<%alias> to add or list command aliases.
+        # Tack preprompt debugger actions ahead of any actual input.
+        @typeahead = ( @$pretype, @typeahead );
 
-=head4 C<source> - read commands from a file.
+=head2 WHERE ARE WE?
 
-Opens a lexical filehandle and stacks it on C<@cmdfhs>; C<DB::readline> will
-pick it up.
+XXX Relocate this section?
 
-=head4 C<enable> C<disable> - enable or disable breakpoints
+The debugger normally shows the line corresponding to the current line of
+execution. Sometimes, though, we want to see the next line, or to move elsewhere
+in the file. This is done via the C<$incr>, C<$start>, and C<$max> variables.
 
-This enables or disables breakpoints.
+C<$incr> controls by how many lines the I<current> line should move forward
+after a command is executed. If set to -1, this indicates that the I<current>
+line shouldn't change.
 
-=head4 C<save> - send current history to a file
+C<$start> is the I<current> line. It is used for things like knowing where to
+move forwards or backwards from when doing an C<L> or C<-> command.
 
-Takes the complete history, (not the shrunken version you see with C<H>),
-and saves it to the given filename, so it can be replayed using C<source>.
+C<$max> tells the debugger where the last line of the current file is. It's
+used to terminate loops most often.
 
-Note that all C<^(save|source)>'s are commented out with a view to minimise recursion.
+=head2 THE COMMAND LOOP
 
-=head4 C<R> - restart
+Most of C<DB::DB> is actually a command parsing and dispatch loop. It comes
+in two parts:
 
-Restart the debugger session.
+=over 4
 
-=head4 C<rerun> - rerun the current session
+=item *
 
-Return to any given position in the B<true>-history list
+The outer part of the loop, starting at the C<CMD> label. This loop
+reads a command and then executes it.
 
-=head4 C<|, ||> - pipe output through the pager.
+=item *
 
-For C<|>, we save C<OUT> (the debugger's output filehandle) and C<STDOUT>
-(the program's standard output). For C<||>, we only save C<OUT>. We open a
-pipe to the pager (restoring the output filehandles if this fails). If this
-is the C<|> command, we also set up a C<SIGPIPE> handler which will simply
-set C<$signal>, sending us back into the debugger.
+The inner part of the loop, starting at the C<PIPE> label. This part
+is wholly contained inside the C<CMD> block and only executes a command.
+Used to handle commands running inside a pager.
 
-We then trim off the pipe symbols and C<redo> the command loop at the
-C<PIPE> label, causing us to evaluate the command in C<$cmd> without
-reading another.
+=back
+
+So why have two labels to restart the loop? Because sometimes, it's easier to
+have a command I<generate> another command and then re-execute the loop to do
+the new command. This is faster, but perhaps a bit more convoluted.
 
 =cut
 
-                # || - run command in the pager, with output to DB::OUT.
-                _DB__handle_run_command_in_pager_command($obj);
+        # The big command dispatch loop. It keeps running until the
+        # user yields up control again.
+        #
+        # If we have a terminal for input, and we get something back
+        # from readline(), keep on processing.
 
-=head3 END OF COMMAND PARSING
+      CMD:
+        while (_DB__read_next_cmd($tid))
+        {
 
-Anything left in C<$cmd> at this point is a Perl expression that we want to
-evaluate. We'll always evaluate in the user's context, and fully qualify
-any variables we might want to address in the C<DB> package.
+            share($cmd);
+            # ... try to execute the input as debugger commands.
 
-=cut
+            # Don't stop running.
+            $single = 0;
 
-            }    # PIPE:
+            # No signal is active.
+            $signal = 0;
 
-            # trace an expression
-            $cmd =~ s/^t\s/\$DB::trace |= 1;\n/;
+            # Handle continued commands (ending with \):
+            if ($cmd =~ s/\\\z/\n/) {
+                $cmd .= DB::readline("  cont: ");
+                redo CMD;
+            }
 
-            # Make sure the flag that says "the debugger's running" is
-            # still on, to make sure we get control again.
-            $evalarg = "\$^D = \$^D | \$DB::db_stop;\n$cmd";
+=head4 The null command
 
-            # Run *our* eval that executes in the caller's context.
-            # The &-call is here to ascertain the mutability of @_.
-            &DB::eval;
+A newline entered by itself means I<re-execute the last command>. We grab the
+command out of C<$laststep> (where it was recorded previously), and copy it
+back into C<$cmd> to be executed below. If there wasn't any previous command,
+we'll do nothing below (no command will match). If there was, we also save it
+in the command history and fall through to allow the command parsing to pick
+it up.
 
-            # Turn off the one-time-dump stuff now.
-            if ($onetimeDump) {
-                $onetimeDump      = undef;
-                $onetimedumpDepth = undef;
-            }
-            elsif ( $term_pid == $$ ) {
-                eval { # May run under miniperl, when not available...
-                    STDOUT->flush();
-                    STDERR->flush();
-                };
+=cut
 
-                # XXX If this is the master pid, print a newline.
-                print {$OUT} "\n";
+            # Empty input means repeat the last command.
+            if ($cmd eq '') {
+                $cmd = $laststep;
             }
-        } ## end while (($term || &setterm...
+            chomp($cmd);    # get rid of the annoying extra newline
+            if (length($cmd) >= option_val('HistItemMinLength', 2)) {
+                push( @hist, $cmd );
+            }
+            push( @truehist, $cmd );
+            share(@hist);
+            share(@truehist);
 
-=head3 POST-COMMAND PROCESSING
+            # This is a restart point for commands that didn't arrive
+            # via direct user input. It allows us to 'redo PIPE' to
+            # re-execute command processing without reading a new command.
+          PIPE: {
+                _DB__trim_command_and_return_first_component($obj);
 
-After each command, we check to see if the command output was piped anywhere.
-If so, we go through the necessary code to unhook the pipe and go back to
-our standard filehandles for input and output.
+=head3 COMMAND ALIASES
+
+The debugger can create aliases for commands (these are stored in the
+C<%alias> hash). Before a command is executed, the command loop looks it up
+in the alias hash and substitutes the contents of the alias for the command,
+completely replacing it.
 
 =cut
 
-        continue {    # CMD:
-            _DB__at_end_of_every_command($obj);
-        }    # CMD:
+                # See if there's an alias for the command, and set it up if so.
+                if ( $alias{$cmd_verb} ) {
 
-=head3 COMMAND LOOP TERMINATION
+                    # Squelch signal handling; we want to keep control here
+                    # if something goes loco during the alias eval.
+                    local $SIG{__DIE__};
+                    local $SIG{__WARN__};
 
-When commands have finished executing, we come here. If the user closed the
-input filehandle, we turn on C<$fall_off_end> to emulate a C<q> command. We
-evaluate any post-prompt items. We restore C<$@>, C<$!>, C<$^E>, C<$,>, C<$/>,
-C<$\>, and C<$^W>, and return a null list as expected by the Perl interpreter.
-The interpreter will then execute the next line and then return control to us
-again.
+                    # This is a command, so we eval it in the DEBUGGER's
+                    # scope! Otherwise, we can't see the special debugger
+                    # variables, or get to the debugger's subs. (Well, we
+                    # _could_, but why make it even more complicated?)
+                    eval "\$cmd =~ $alias{$cmd_verb}";
+                    if ($@) {
+                        local $\ = '';
+                        print $OUT "Couldn't evaluate '$cmd_verb' alias: $@";
+                        next CMD;
+                    }
+                    _DB__trim_command_and_return_first_component($obj);
+                } ## end if ($alias{$cmd_verb})
 
-=cut
+=head3 MAIN-LINE COMMANDS
 
-        # No more commands? Quit.
-        $fall_off_end = 1 unless defined $cmd;    # Emulate 'q' on EOF
+All of these commands work up to and after the program being debugged has
+terminated.
 
-        # Evaluate post-prompt commands.
-        foreach $evalarg (@$post) {
-            # The &-call is here to ascertain the mutability of @_.
-            &DB::eval;
-        }
-    }    # if ($single || $signal)
+=head4 C<q> - quit
 
-    # Put the user's globals back where you found them.
-    ( $@, $!, $^E, $,, $/, $\, $^W ) = @saved;
-    ();
-} ## end sub DB
+Quit the debugger. This entails setting the C<$fall_off_end> flag, so we don't
+try to execute further, cleaning any restart-related stuff out of the
+environment, and executing with the last value of C<$?>.
 
-# Because DB::Obj is used above,
-#
-#   my $obj = DB::Obj->new(
-#
-# The following package declaration must come before that,
-# or else runtime errors will occur with
-#
-#   PERLDB_OPTS="autotrace nonstop"
-#
-# ( rt#116771 )
-BEGIN {
+=cut
 
-package DB::Obj;
+                # All of these commands were remapped in perl 5.8.0;
+                # we send them off to the secondary dispatcher (see below).
+                $obj->_handle_special_char_cmd_wrapper_commands;
+                _DB__trim_command_and_return_first_component($obj);
 
-sub new {
-    my $class = shift;
+                if (my $cmd_rec = $cmd_lookup{$cmd_verb}) {
+                    my $type = $cmd_rec->{t};
+                    my $val = $cmd_rec->{v};
+                    if ($type eq 'm') {
+                        $obj->$val();
+                    }
+                    elsif ($type eq 's') {
+                        $val->($obj);
+                    }
+                }
 
-    my $self = bless {}, $class;
+=head4 C<t> - trace [n]
 
-    $self->_init(@_);
+Turn tracing on or off. Inverts the appropriate bit in C<$trace> (q.v.).
+If level is specified, set C<$trace_to_depth>.
 
-    return $self;
-}
+=head4 C<S> - list subroutines matching/not matching a pattern
 
-sub _init {
-    my ($self, $args) = @_;
+Walks through C<%sub>, checking to see whether or not to print the name.
 
-    %{$self} = (%$self, %$args);
+=head4 C<X> - list variables in current package
 
-    return;
-}
+Since the C<V> command actually processes this, just change this to the
+appropriate C<V> command and fall through.
 
-{
-    no strict 'refs';
-    foreach my $slot_name (qw(
-        after explicit_stop infix pat piped position prefix selected cmd_verb
-        cmd_args
-        )) {
-        my $slot = $slot_name;
-        *{$slot} = sub {
-            my $self = shift;
+=head4 C<V> - list variables
 
-            if (@_) {
-                ${ $self->{$slot} } = shift;
-            }
+Uses C<dumpvar.pl> to dump out the current values for selected variables.
 
-            return ${ $self->{$slot} };
-        };
+=head4 C<x> - evaluate and print an expression
 
-        *{"append_to_$slot"} = sub {
-            my $self = shift;
-            my $s = shift;
+Hands the expression off to C<DB::eval>, setting it up to print the value
+via C<dumpvar.pl> instead of just printing it directly.
 
-            return $self->$slot($self->$slot . $s);
-        };
-    }
-}
+=head4 C<m> - print methods
 
-sub _DB_on_init__initialize_globals
-{
-    my $self = shift;
+Just uses C<DB::methods> to determine what methods are available.
 
-    # Check for whether we should be running continuously or not.
-    # _After_ the perl program is compiled, $single is set to 1:
-    if ( $single and not $second_time++ ) {
+=head4 C<f> - switch files
 
-        # Options say run non-stop. Run until we get an interrupt.
-        if ($runnonstop) {    # Disable until signal
-                # If there's any call stack in place, turn off single
-                # stepping into subs throughout the stack.
-            for my $i (0 .. $stack_depth) {
-                $stack[ $i ] &= ~1;
-            }
+Switch to a different filename.
 
-            # And we are now no longer in single-step mode.
-            $single = 0;
+=head4 C<.> - return to last-executed line.
 
-            # If we simply returned at this point, we wouldn't get
-            # the trace info. Fall on through.
-            # return;
-        } ## end if ($runnonstop)
+We set C<$incr> to -1 to indicate that the debugger shouldn't move ahead,
+and then we look up the line in the magical C<%dbline> hash.
 
-        elsif ($ImmediateStop) {
+=head4 C<-> - back one window
 
-            # We are supposed to stop here; XXX probably a break.
-            $ImmediateStop = 0;    # We've processed it; turn it off
-            $signal        = 1;    # Simulate an interrupt to force
-                                   # us into the command loop
-        }
-    } ## end if ($single and not $second_time...
+We change C<$start> to be one window back; if we go back past the first line,
+we set it to be the first line. We set C<$incr> to put us back at the
+currently-executing line, and then put a C<l $start +> (list one window from
+C<$start>) in C<$cmd> to be executed later.
+
+=head3 PRE-580 COMMANDS VS. NEW COMMANDS: C<a, A, b, B, h, l, L, M, o, O, P, v, w, W, E<lt>, E<lt>E<lt>, E<0x7B>, E<0x7B>E<0x7B>>
+
+In Perl 5.8.0, a realignment of the commands was done to fix up a number of
+problems, most notably that the default case of several commands destroying
+the user's work in setting watchpoints, actions, etc. We wanted, however, to
+retain the old commands for those who were used to using them or who preferred
+them. At this point, we check for the new commands and call C<cmd_wrapper> to
+deal with them instead of processing them in-line.
 
-    # If we're in single-step mode, or an interrupt (real or fake)
-    # has occurred, turn off non-stop mode.
-    $runnonstop = 0 if $single or $signal;
+=head4 C<y> - List lexicals in higher scope
 
-    return;
-}
+Uses C<PadWalker> to find the lexicals supplied as arguments in a scope
+above the current one and then displays then using C<dumpvar.pl>.
 
-sub _my_print_lineinfo
-{
-    my ($self, $i, $incr_pos) = @_;
+=head3 COMMANDS NOT WORKING AFTER PROGRAM ENDS
 
-    if ($frame) {
-        # Print it indented if tracing is on.
-        DB::print_lineinfo( ' ' x $stack_depth,
-            "$i:\t$DB::dbline[$i]" . $self->after );
-    }
-    else {
-        DB::depth_print_lineinfo($self->explicit_stop, $incr_pos);
-    }
-}
+All of the commands below this point don't work after the program being
+debugged has ended. All of them check to see if the program has ended; this
+allows the commands to be relocated without worrying about a 'line of
+demarcation' above which commands can be entered anytime, and below which
+they can't.
 
-sub _curr_line {
-    return $DB::dbline[$line];
-}
+=head4 C<n> - single step, but don't trace down into subs
 
-sub _is_full {
-    my ($self, $letter) = @_;
+Done by setting C<$single> to 2, which forces subs to execute straight through
+when entered (see C<DB::sub>). We also save the C<n> command in C<$laststep>,
+so a null command knows what to re-execute.
 
-    return ($DB::cmd eq $letter);
-}
+=head4 C<s> - single-step, entering subs
 
-sub _DB__grab_control
-{
-    my $self = shift;
+Sets C<$single> to 1, which causes C<DB::sub> to continue tracing inside
+subs. Also saves C<s> as C<$lastcmd>.
 
-    # Yes, grab control.
-    if ($slave_editor) {
+=head4 C<c> - run continuously, setting an optional breakpoint
 
-        # Tell the editor to update its position.
-        $self->position("\032\032${DB::filename}:$line:0\n");
-        DB::print_lineinfo($self->position());
-    }
+Most of the code for this command is taken up with locating the optional
+breakpoint, which is either a subroutine name or a line number. We set
+the appropriate one-time-break in C<@dbline> and then turn off single-stepping
+in this and all call levels above this one.
 
-=pod
+=head4 C<r> - return from a subroutine
 
-Special check: if we're in package C<DB::fake>, we've gone through the
-C<END> block at least once. We set up everything so that we can continue
-to enter commands and have a valid context to be in.
+For C<r> to work properly, the debugger has to stop execution again
+immediately after the return is executed. This is done by forcing
+single-stepping to be on in the call level above the current one. If
+we are printing return values when a C<r> is executed, set C<$doret>
+appropriately, and force us out of the command loop.
 
-=cut
+=head4 C<T> - stack trace
 
-    elsif ( $DB::package eq 'DB::fake' ) {
+Just calls C<DB::print_trace>.
 
-        # Fallen off the end already.
-        if (!$DB::term) {
-            DB::setterm();
-        }
+=head4 C<w> - List window around current line.
 
-        DB::print_help(<<EOP);
-Debugged program terminated.  Use B<q> to quit or B<R> to restart,
-use B<o> I<inhibit_exit> to avoid stopping after program termination,
-B<h q>, B<h R> or B<h o> to get additional info.
-EOP
+Just calls C<DB::cmd_w>.
 
-        $DB::package     = 'main';
-        $DB::usercontext = DB::_calc_usercontext($DB::package);
-    } ## end elsif ($package eq 'DB::fake')
+=head4 C<W> - watch-expression processing.
 
-=pod
+Just calls C<DB::cmd_W>.
 
-If the program hasn't finished executing, we scan forward to the
-next executable line, print that out, build the prompt from the file and line
-number information, and print that.
+=head4 C</> - search forward for a string in the source
+
+We take the argument and treat it as a pattern. If it turns out to be a
+bad one, we return the error we got from trying to C<eval> it and exit.
+If not, we create some code to do the search and C<eval> it so it can't
+mess us up.
 
 =cut
 
-    else {
+                _DB__handle_forward_slash_command($obj);
 
+=head4 C<?> - search backward for a string in the source
 
-        # Still somewhere in the midst of execution. Set up the
-        #  debugger prompt.
-        $DB::sub =~ s/\'/::/;    # Swap Perl 4 package separators (') to
-                             # Perl 5 ones (sorry, we don't print Klingon
-                             #module names)
+Same as for C</>, except the loop runs backwards.
 
-        $self->prefix($DB::sub =~ /::/ ? "" : ($DB::package . '::'));
-        $self->append_to_prefix( "$DB::sub(${DB::filename}:" );
-        $self->after( $self->_curr_line =~ /\n$/ ? '' : "\n" );
+=cut
 
-        # Break up the prompt if it's really long.
-        if ( length($self->prefix()) > 30 ) {
-            $self->position($self->prefix . "$line):\n$line:\t" . $self->_curr_line . $self->after);
-            $self->prefix("");
-            $self->infix(":\t");
-        }
-        else {
-            $self->infix("):\t");
-            $self->position(
-                $self->prefix . $line. $self->infix
-                . $self->_curr_line . $self->after
-            );
-        }
+                _DB__handle_question_mark_command($obj);
 
-        # Print current line info, indenting if necessary.
-        $self->_my_print_lineinfo($line, $self->position);
+=head4 C<$rc> - Recall command
 
-        my $i;
-        my $line_i = sub { return $DB::dbline[$i]; };
+Manages the commands in C<@hist> (which is created if C<Term::ReadLine> reports
+that the terminal supports history). It finds the command required, puts it
+into C<$cmd>, and redoes the loop to execute it.
 
-        # Scan forward, stopping at either the end or the next
-        # unbreakable line.
-        for ( $i = $line + 1 ; $i <= $DB::max && $line_i->() == 0 ; ++$i )
-        {    #{ vi
+=cut
 
-            # Drop out on null statements, block closers, and comments.
-            last if $line_i->() =~ /^\s*[\;\}\#\n]/;
+                # $rc - recall command.
+                $obj->_handle_rc_recall_command;
 
-            # Drop out if the user interrupted us.
-            last if $signal;
+=head4 C<$sh$sh> - C<system()> command
 
-            # Append a newline if the line doesn't have one. Can happen
-            # in eval'ed text, for instance.
-            $self->after( $line_i->() =~ /\n$/ ? '' : "\n" );
+Calls the C<_db_system()> to handle the command. This keeps the C<STDIN> and
+C<STDOUT> from getting messed up.
 
-            # Next executable line.
-            my $incr_pos = $self->prefix . $i . $self->infix . $line_i->()
-                . $self->after;
-            $self->append_to_position($incr_pos);
-            $self->_my_print_lineinfo($i, $incr_pos);
-        } ## end for ($i = $line + 1 ; $i...
-    } ## end else [ if ($slave_editor)
+=cut
 
-    return;
-}
+                $obj->_handle_sh_command;
 
-sub _handle_t_command {
-    my $self = shift;
+=head4 C<$rc I<pattern> $rc> - Search command history
 
-    my $levels = $self->cmd_args();
+Another command to manipulate C<@hist>: this one searches it with a pattern.
+If a command is found, it is placed in C<$cmd> and executed via C<redo>.
 
-    if ((!length($levels)) or ($levels !~ /\D/)) {
-        $trace ^= 1;
-        local $\ = '';
-        $DB::trace_to_depth = $levels ? $stack_depth + $levels : 1E9;
-        print {$OUT} "Trace = "
-        . ( ( $trace & 1 )
-            ? ( $levels ? "on (to level $DB::trace_to_depth)" : "on" )
-            : "off" ) . "\n";
-        next CMD;
-    }
+=cut
 
-    return;
-}
+                $obj->_handle_rc_search_history_command;
 
+=head4 C<$sh> - Invoke a shell
 
-sub _handle_S_command {
-    my $self = shift;
+Uses C<_db_system()> to invoke a shell.
 
-    if (my ($print_all_subs, $should_reverse, $Spatt)
-        = $self->cmd_args =~ /\A((!)?(.+))?\z/) {
-        # $Spatt is the pattern (if any) to use.
-        # Reverse scan?
-        my $Srev     = defined $should_reverse;
-        # No args - print all subs.
-        my $Snocheck = !defined $print_all_subs;
+=cut
 
-        # Need to make these sane here.
-        local $\ = '';
-        local $, = '';
+=head4 C<$sh I<command>> - Force execution of a command in a shell
 
-        # Search through the debugger's magical hash of subs.
-        # If $nocheck is true, just print the sub name.
-        # Otherwise, check it against the pattern. We then use
-        # the XOR trick to reverse the condition as required.
-        foreach $subname ( sort( keys %sub ) ) {
-            if ( $Snocheck or $Srev ^ ( $subname =~ /$Spatt/ ) ) {
-                print $OUT $subname, "\n";
-            }
-        }
-        next CMD;
-    }
+Like the above, but the command is passed to the shell. Again, we use
+C<_db_system()> to avoid problems with C<STDIN> and C<STDOUT>.
 
-    return;
-}
+=head4 C<H> - display commands in history
 
-sub _handle_V_command_and_X_command {
-    my $self = shift;
+Prints the contents of C<@hist> (if any).
 
-    $DB::cmd =~ s/^X\b/V $DB::package/;
+=head4 C<man, doc, perldoc> - look up documentation
 
-    # Bare V commands get the currently-being-debugged package
-    # added.
-    if ($self->_is_full('V')) {
-        $DB::cmd = "V $DB::package";
-    }
+Just calls C<runman()> to print the appropriate document.
 
-    # V - show variables in package.
-    if (my ($new_packname, $new_vars_str) =
-        $DB::cmd =~ /\AV\b\s*(\S+)\s*(.*)/) {
+=cut
 
-        # Save the currently selected filehandle and
-        # force output to debugger's filehandle (dumpvar
-        # just does "print" for output).
-        my $savout = select($OUT);
+                $obj->_handle_doc_command;
 
-        # Grab package name and variables to dump.
-        $packname = $new_packname;
-        my @vars     = split( ' ', $new_vars_str );
+=head4 C<p> - print
 
-        # If main::dumpvar isn't here, get it.
-        do 'dumpvar.pl' || die $@ unless defined &main::dumpvar;
-        if ( defined &main::dumpvar ) {
+Builds a C<print EXPR> expression in the C<$cmd>; this will get executed at
+the bottom of the loop.
 
-            # We got it. Turn off subroutine entry/exit messages
-            # for the moment, along with return values.
-            local $frame = 0;
-            local $doret = -2;
+=head4 C<=> - define command alias
 
-            # must detect sigpipe failures  - not catching
-            # then will cause the debugger to die.
-            eval {
-                main::dumpvar(
-                    $packname,
-                    defined $option{dumpDepth}
-                    ? $option{dumpDepth}
-                    : -1,    # assume -1 unless specified
-                    @vars
-                );
-            };
+Manipulates C<%alias> to add or list command aliases.
 
-            # The die doesn't need to include the $@, because
-            # it will automatically get propagated for us.
-            if ($@) {
-                die unless $@ =~ /dumpvar print failed/;
-            }
-        } ## end if (defined &main::dumpvar)
-        else {
+=head4 C<source> - read commands from a file.
 
-            # Couldn't load dumpvar.
-            print $OUT "dumpvar.pl not available.\n";
-        }
+Opens a lexical filehandle and stacks it on C<@cmdfhs>; C<DB::readline> will
+pick it up.
 
-        # Restore the output filehandle, and go round again.
-        select($savout);
-        next CMD;
-    }
+=head4 C<enable> C<disable> - enable or disable breakpoints
 
-    return;
-}
+This enables or disables breakpoints.
 
-sub _handle_dash_command {
-    my $self = shift;
+=head4 C<save> - send current history to a file
 
-    if ($self->_is_full('-')) {
+Takes the complete history, (not the shrunken version you see with C<H>),
+and saves it to the given filename, so it can be replayed using C<source>.
 
-        # back up by a window; go to 1 if back too far.
-        $start -= $incr + $window + 1;
-        $start = 1 if $start <= 0;
-        $incr  = $window - 1;
+Note that all C<^(save|source)>'s are commented out with a view to minimise recursion.
 
-        # Generate and execute a "l +" command (handled below).
-        $DB::cmd = 'l ' . ($start) . '+';
-        redo CMD;
-    }
-    return;
-}
+=head4 C<R> - restart
 
-sub _n_or_s_commands_generic {
-    my ($self, $new_val) = @_;
-    # n - next
-    next CMD if DB::_DB__is_finished();
+Restart the debugger session.
 
-    # Single step, but don't enter subs.
-    $single = $new_val;
+=head4 C<rerun> - rerun the current session
 
-    # Save for empty command (repeat last).
-    $laststep = $DB::cmd;
-    last CMD;
-}
+Return to any given position in the B<true>-history list
 
-sub _n_or_s {
-    my ($self, $letter, $new_val) = @_;
+=head4 C<|, ||> - pipe output through the pager.
 
-    if ($self->_is_full($letter)) {
-        $self->_n_or_s_commands_generic($new_val);
-    }
-    else {
-        $self->_n_or_s_and_arg_commands_generic($letter, $new_val);
-    }
+For C<|>, we save C<OUT> (the debugger's output filehandle) and C<STDOUT>
+(the program's standard output). For C<||>, we only save C<OUT>. We open a
+pipe to the pager (restoring the output filehandles if this fails). If this
+is the C<|> command, we also set up a C<SIGPIPE> handler which will simply
+set C<$signal>, sending us back into the debugger.
 
-    return;
-}
+We then trim off the pipe symbols and C<redo> the command loop at the
+C<PIPE> label, causing us to evaluate the command in C<$cmd> without
+reading another.
 
-sub _handle_n_command {
-    my $self = shift;
+=cut
 
-    return $self->_n_or_s('n', 2);
-}
+                # || - run command in the pager, with output to DB::OUT.
+                _DB__handle_run_command_in_pager_command($obj);
 
-sub _handle_s_command {
-    my $self = shift;
+=head3 END OF COMMAND PARSING
 
-    return $self->_n_or_s('s', 1);
-}
+Anything left in C<$cmd> at this point is a Perl expression that we want to
+evaluate. We'll always evaluate in the user's context, and fully qualify
+any variables we might want to address in the C<DB> package.
 
-sub _handle_r_command {
-    my $self = shift;
+=cut
 
-    # r - return from the current subroutine.
-    if ($self->_is_full('r')) {
+            }    # PIPE:
 
-        # Can't do anything if the program's over.
-        next CMD if DB::_DB__is_finished();
+            # trace an expression
+            $cmd =~ s/^t\s/\$DB::trace |= 1;\n/;
 
-        # Turn on stack trace.
-        $stack[$stack_depth] |= 1;
+            # Make sure the flag that says "the debugger's running" is
+            # still on, to make sure we get control again.
+            $evalarg = "\$^D = \$^D | \$DB::db_stop;\n$cmd";
 
-        # Print return value unless the stack is empty.
-        $doret = $option{PrintRet} ? $stack_depth - 1 : -2;
-        last CMD;
-    }
+            # Run *our* eval that executes in the caller's context.
+            # The &-call is here to ascertain the mutability of @_.
+            &DB::eval;
 
-    return;
-}
+            # Turn off the one-time-dump stuff now.
+            if ($onetimeDump) {
+                $onetimeDump      = undef;
+                $onetimedumpDepth = undef;
+            }
+            elsif ( $term_pid == $$ ) {
+                eval { # May run under miniperl, when not available...
+                    STDOUT->flush();
+                    STDERR->flush();
+                };
 
-sub _handle_T_command {
-    my $self = shift;
+                # XXX If this is the master pid, print a newline.
+                print {$OUT} "\n";
+            }
+        } ## end while (($term || &setterm...
 
-    if ($self->_is_full('T')) {
-        DB::print_trace( $OUT, 1 );    # skip DB
-        next CMD;
-    }
+=head3 POST-COMMAND PROCESSING
 
-    return;
-}
+After each command, we check to see if the command output was piped anywhere.
+If so, we go through the necessary code to unhook the pipe and go back to
+our standard filehandles for input and output.
 
-sub _handle_w_command {
-    my $self = shift;
+=cut
 
-    DB::cmd_w( 'w', $self->cmd_args() );
-    next CMD;
+        continue {    # CMD:
+            _DB__at_end_of_every_command($obj);
+        }    # CMD:
 
-    return;
-}
+=head3 COMMAND LOOP TERMINATION
 
-sub _handle_W_command {
-    my $self = shift;
+When commands have finished executing, we come here. If the user closed the
+input filehandle, we turn on C<$fall_off_end> to emulate a C<q> command. We
+evaluate any post-prompt items. We restore C<$@>, C<$!>, C<$^E>, C<$,>, C<$/>,
+C<$\>, and C<$^W>, and return a null list as expected by the Perl interpreter.
+The interpreter will then execute the next line and then return control to us
+again.
 
-    if (my $arg = $self->cmd_args) {
-        DB::cmd_W( 'W', $arg );
-        next CMD;
-    }
+=cut
 
-    return;
-}
+        # No more commands? Quit.
+        $fall_off_end = 1 unless defined $cmd;    # Emulate 'q' on EOF
 
-sub _handle_rc_recall_command {
-    my $self = shift;
+        # Evaluate post-prompt commands.
+        foreach $evalarg (@$post) {
+            # The &-call is here to ascertain the mutability of @_.
+            &DB::eval;
+        }
+    }    # if ($single || $signal)
 
-    # $rc - recall command.
-    if (my ($minus, $arg) = $DB::cmd =~ m#\A$rc+\s*(-)?(\d+)?\z#) {
+    # Put the user's globals back where you found them.
+    ( $@, $!, $^E, $,, $/, $\, $^W ) = @saved;
+    ();
+} ## end sub DB
 
-        # No arguments, take one thing off history.
-        pop(@hist) if length($DB::cmd) > 1;
+# Because DB::Obj is used above,
+#
+#   my $obj = DB::Obj->new(
+#
+# The following package declaration must come before that,
+# or else runtime errors will occur with
+#
+#   PERLDB_OPTS="autotrace nonstop"
+#
+# ( rt#116771 )
+BEGIN {
 
-        # Relative (- found)?
-        #  Y - index back from most recent (by 1 if bare minus)
-        #  N - go to that particular command slot or the last
-        #      thing if nothing following.
+package DB::Obj;
 
-        $self->cmd_verb(
-            scalar($minus ? ( $#hist - ( $arg || 1 ) ) : ( $arg || $#hist ))
-        );
+sub new {
+    my $class = shift;
 
-        # Pick out the command desired.
-        $DB::cmd = $hist[$self->cmd_verb];
+    my $self = bless {}, $class;
 
-        # Print the command to be executed and restart the loop
-        # with that command in the buffer.
-        print {$OUT} $DB::cmd, "\n";
-        redo CMD;
-    }
+    $self->_init(@_);
 
-    return;
+    return $self;
 }
 
-sub _handle_rc_search_history_command {
-    my $self = shift;
-
-    # $rc pattern $rc - find a command in the history.
-    if (my ($arg) = $DB::cmd =~ /\A$rc([^$rc].*)\z/) {
+sub _init {
+    my ($self, $args) = @_;
 
-        # Create the pattern to use.
-        my $pat = "^$arg";
-        $self->pat($pat);
+    %{$self} = (%$self, %$args);
 
-        # Toss off last entry if length is >1 (and it always is).
-        pop(@hist) if length($DB::cmd) > 1;
+    return;
+}
 
-        my $i;
+{
+    no strict 'refs';
+    foreach my $slot_name (qw(
+        after explicit_stop infix pat piped position prefix selected cmd_verb
+        cmd_args
+        )) {
+        my $slot = $slot_name;
+        *{$slot} = sub {
+            my $self = shift;
 
-        # Look backward through the history.
-        SEARCH_HIST:
-        for ( $i = $#hist ; $i ; --$i ) {
-            # Stop if we find it.
-            last SEARCH_HIST if $hist[$i] =~ /$pat/;
-        }
+            if (@_) {
+                ${ $self->{$slot} } = shift;
+            }
 
-        if ( !$i ) {
+            return ${ $self->{$slot} };
+        };
 
-            # Never found it.
-            print $OUT "No such command!\n\n";
-            next CMD;
-        }
+        *{"append_to_$slot"} = sub {
+            my $self = shift;
+            my $s = shift;
 
-        # Found it. Put it in the buffer, print it, and process it.
-        $DB::cmd = $hist[$i];
-        print $OUT $DB::cmd, "\n";
-        redo CMD;
+            return $self->$slot($self->$slot . $s);
+        };
     }
-
-    return;
 }
 
-sub _handle_H_command {
+sub _DB_on_init__initialize_globals
+{
     my $self = shift;
 
-    if ($self->cmd_args =~ m#\A\*#) {
-        @hist = @truehist = ();
-        print $OUT "History cleansed\n";
-        next CMD;
-    }
+    # Check for whether we should be running continuously or not.
+    # _After_ the perl program is compiled, $single is set to 1:
+    if ( $single and not $second_time++ ) {
 
-    if (my ($num) = $self->cmd_args =~ /\A(?:-(\d+))?/) {
+        # Options say run non-stop. Run until we get an interrupt.
+        if ($runnonstop) {    # Disable until signal
+                # If there's any call stack in place, turn off single
+                # stepping into subs throughout the stack.
+            for my $i (0 .. $stack_depth) {
+                $stack[ $i ] &= ~1;
+            }
 
-        # Anything other than negative numbers is ignored by
-        # the (incorrect) pattern, so this test does nothing.
-        $end = $num ? ( $#hist - $num ) : 0;
+            # And we are now no longer in single-step mode.
+            $single = 0;
 
-        # Set to the minimum if less than zero.
-        $hist = 0 if $hist < 0;
+            # If we simply returned at this point, we wouldn't get
+            # the trace info. Fall on through.
+            # return;
+        } ## end if ($runnonstop)
 
-        # Start at the end of the array.
-        # Stay in while we're still above the ending value.
-        # Tick back by one each time around the loop.
-        my $i;
+        elsif ($ImmediateStop) {
 
-        for ( $i = $#hist ; $i > $end ; $i-- ) {
-            print $OUT "$i: ", $hist[$i], "\n";
+            # We are supposed to stop here; XXX probably a break.
+            $ImmediateStop = 0;    # We've processed it; turn it off
+            $signal        = 1;    # Simulate an interrupt to force
+                                   # us into the command loop
         }
+    } ## end if ($single and not $second_time...
 
-        next CMD;
-    }
-
-    return;
-}
-
-sub _handle_doc_command {
-    my $self = shift;
-
-    # man, perldoc, doc - show manual pages.
-    if (my ($man_page)
-        = $DB::cmd =~ /\A(?:man|(?:perl)?doc)\b(?:\s+([^(]*))?\z/) {
-        DB::runman($man_page);
-        next CMD;
-    }
+    # If we're in single-step mode, or an interrupt (real or fake)
+    # has occurred, turn off non-stop mode.
+    $runnonstop = 0 if $single or $signal;
 
     return;
 }
 
-sub _handle_p_command {
-    my $self = shift;
+sub _my_print_lineinfo
+{
+    my ($self, $i, $incr_pos) = @_;
 
-    my $print_cmd = 'print {$DB::OUT} ';
-    # p - print (no args): print $_.
-    if ($self->_is_full('p')) {
-        $DB::cmd = $print_cmd . '$_';
+    if ($frame) {
+        # Print it indented if tracing is on.
+        DB::print_lineinfo( ' ' x $stack_depth,
+            "$i:\t$DB::dbline[$i]" . $self->after );
     }
     else {
-        # p - print the given expression.
-        $DB::cmd =~ s/\Ap\b/$print_cmd /;
+        DB::depth_print_lineinfo($self->explicit_stop, $incr_pos);
     }
-
-    return;
 }
 
-sub _handle_equal_sign_command {
-    my $self = shift;
-
-    if ($DB::cmd =~ s/\A=\s*//) {
-        my @keys;
-        if ( length $DB::cmd == 0 ) {
+sub _curr_line {
+    return $DB::dbline[$line];
+}
 
-            # No args, get current aliases.
-            @keys = sort keys %alias;
-        }
-        elsif ( my ( $k, $v ) = ( $DB::cmd =~ /^(\S+)\s+(\S.*)/ ) ) {
+sub _is_full {
+    my ($self, $letter) = @_;
 
-            # Creating a new alias. $k is alias name, $v is
-            # alias value.
+    return ($DB::cmd eq $letter);
+}
 
-            # can't use $_ or kill //g state
-            for my $x ( $k, $v ) {
+sub _DB__grab_control
+{
+    my $self = shift;
 
-                # Escape "alarm" characters.
-                $x =~ s/\a/\\a/g;
-            }
+    # Yes, grab control.
+    if ($slave_editor) {
 
-            # Substitute key for value, using alarm chars
-            # as separators (which is why we escaped them in
-            # the command).
-            $alias{$k} = "s\a$k\a$v\a";
+        # Tell the editor to update its position.
+        $self->position("\032\032${DB::filename}:$line:0\n");
+        DB::print_lineinfo($self->position());
+    }
 
-            # Turn off standard warn and die behavior.
-            local $SIG{__DIE__};
-            local $SIG{__WARN__};
+=pod
 
-            # Is it valid Perl?
-            unless ( eval "sub { s\a$k\a$v\a }; 1" ) {
+Special check: if we're in package C<DB::fake>, we've gone through the
+C<END> block at least once. We set up everything so that we can continue
+to enter commands and have a valid context to be in.
 
-                # Nope. Bad alias. Say so and get out.
-                print $OUT "Can't alias $k to $v: $@\n";
-                delete $alias{$k};
-                next CMD;
-            }
+=cut
 
-            # We'll only list the new one.
-            @keys = ($k);
-        } ## end elsif (my ($k, $v) = ($DB::cmd...
+    elsif ( $DB::package eq 'DB::fake' ) {
 
-        # The argument is the alias to list.
-        else {
-            @keys = ($DB::cmd);
+        # Fallen off the end already.
+        if (!$DB::term) {
+            DB::setterm();
         }
 
-        # List aliases.
-        for my $k (@keys) {
+        DB::print_help(<<EOP);
+Debugged program terminated.  Use B<q> to quit or B<R> to restart,
+use B<o> I<inhibit_exit> to avoid stopping after program termination,
+B<h q>, B<h R> or B<h o> to get additional info.
+EOP
 
-            # Messy metaquoting: Trim the substitution code off.
-            # We use control-G as the delimiter because it's not
-            # likely to appear in the alias.
-            if ( ( my $v = $alias{$k} ) =~ s\as\a$k\a(.*)\a$\a1\a ) {
+        $DB::package     = 'main';
+        $DB::usercontext = DB::_calc_usercontext($DB::package);
+    } ## end elsif ($package eq 'DB::fake')
 
-                # Print the alias.
-                print $OUT "$k\t= $1\n";
-            }
-            elsif ( defined $alias{$k} ) {
+=pod
 
-                # Couldn't trim it off; just print the alias code.
-                print $OUT "$k\t$alias{$k}\n";
-            }
-            else {
+If the program hasn't finished executing, we scan forward to the
+next executable line, print that out, build the prompt from the file and line
+number information, and print that.
 
-                # No such, dude.
-                print "No alias for $k\n";
-            }
-        } ## end for my $k (@keys)
-        next CMD;
-    }
+=cut
 
-    return;
-}
+    else {
 
-sub _handle_source_command {
-    my $self = shift;
 
-    # source - read commands from a file (or pipe!) and execute.
-    if (my $sourced_fn = $self->cmd_args) {
-        if ( open my $fh, $sourced_fn ) {
+        # Still somewhere in the midst of execution. Set up the
+        #  debugger prompt.
+        $DB::sub =~ s/\'/::/;    # Swap Perl 4 package separators (') to
+                             # Perl 5 ones (sorry, we don't print Klingon
+                             #module names)
 
-            # Opened OK; stick it in the list of file handles.
-            push @cmdfhs, $fh;
+        $self->prefix($DB::sub =~ /::/ ? "" : ($DB::package . '::'));
+        $self->append_to_prefix( "$DB::sub(${DB::filename}:" );
+        $self->after( $self->_curr_line =~ /\n$/ ? '' : "\n" );
+
+        # Break up the prompt if it's really long.
+        if ( length($self->prefix()) > 30 ) {
+            $self->position($self->prefix . "$line):\n$line:\t" . $self->_curr_line . $self->after);
+            $self->prefix("");
+            $self->infix(":\t");
         }
         else {
-
-            # Couldn't open it.
-            DB::_db_warn("Can't execute '$sourced_fn': $!\n");
+            $self->infix("):\t");
+            $self->position(
+                $self->prefix . $line. $self->infix
+                . $self->_curr_line . $self->after
+            );
         }
-        next CMD;
-    }
-
-    return;
-}
 
-sub _handle_enable_disable_commands {
-    my $self = shift;
+        # Print current line info, indenting if necessary.
+        $self->_my_print_lineinfo($line, $self->position);
 
-    my $which_cmd = $self->cmd_verb;
-    my $position = $self->cmd_args;
+        my $i;
+        my $line_i = sub { return $DB::dbline[$i]; };
 
-    if ($position !~ /\s/) {
-        my ($fn, $line_num);
-        if ($position =~ m{\A\d+\z})
-        {
-            $fn = $DB::filename;
-            $line_num = $position;
-        }
-        elsif (my ($new_fn, $new_line_num)
-            = $position =~ m{\A(.*):(\d+)\z}) {
-            ($fn, $line_num) = ($new_fn, $new_line_num);
-        }
-        else
-        {
-            DB::_db_warn("Wrong spec for enable/disable argument.\n");
-        }
+        # Scan forward, stopping at either the end or the next
+        # unbreakable line.
+        for ( $i = $line + 1 ; $i <= $DB::max && $line_i->() == 0 ; ++$i )
+        {    #{ vi
 
-        if (defined($fn)) {
-            if (DB::_has_breakpoint_data_ref($fn, $line_num)) {
-                DB::_set_breakpoint_enabled_status($fn, $line_num,
-                    ($which_cmd eq 'enable' ? 1 : '')
-                );
-            }
-            else {
-                DB::_db_warn("No breakpoint set at ${fn}:${line_num}\n");
-            }
-        }
+            # Drop out on null statements, block closers, and comments.
+            last if $line_i->() =~ /^\s*[\;\}\#\n]/;
 
-        next CMD;
-    }
+            # Drop out if the user interrupted us.
+            last if $signal;
+
+            # Append a newline if the line doesn't have one. Can happen
+            # in eval'ed text, for instance.
+            $self->after( $line_i->() =~ /\n$/ ? '' : "\n" );
+
+            # Next executable line.
+            my $incr_pos = $self->prefix . $i . $self->infix . $line_i->()
+                . $self->after;
+            $self->append_to_position($incr_pos);
+            $self->_my_print_lineinfo($i, $incr_pos);
+        } ## end for ($i = $line + 1 ; $i...
+    } ## end else [ if ($slave_editor)
 
     return;
 }
 
-sub _handle_save_command {
+sub _handle_t_command {
     my $self = shift;
 
-    if (my $new_fn = $self->cmd_args) {
-        my $filename = $new_fn || '.perl5dbrc';    # default?
-        if ( open my $fh, '>', $filename ) {
+    my $levels = $self->cmd_args();
 
-            # chomp to remove extraneous newlines from source'd files
-            chomp( my @truelist =
-                map { m/\A\s*(save|source)/ ? "#$_" : $_ }
-                @truehist );
-            print {$fh} join( "\n", @truelist );
-            print "commands saved in $filename\n";
-        }
-        else {
-            DB::_db_warn("Can't save debugger commands in '$new_fn': $!\n");
-        }
+    if ((!length($levels)) or ($levels !~ /\D/)) {
+        $trace ^= 1;
+        local $\ = '';
+        $DB::trace_to_depth = $levels ? $stack_depth + $levels : 1E9;
+        print {$OUT} "Trace = "
+        . ( ( $trace & 1 )
+            ? ( $levels ? "on (to level $DB::trace_to_depth)" : "on" )
+            : "off" ) . "\n";
         next CMD;
     }
 
     return;
 }
 
-sub _n_or_s_and_arg_commands_generic {
-    my ($self, $letter, $new_val) = @_;
 
-    # s - single-step. Remember the last command was 's'.
-    if ($DB::cmd =~ s#\A\Q$letter\E\s#\$DB::single = $new_val;\n#) {
-        $laststep = $letter;
+sub _handle_S_command {
+    my $self = shift;
+
+    if (my ($print_all_subs, $should_reverse, $Spatt)
+        = $self->cmd_args =~ /\A((!)?(.+))?\z/) {
+        # $Spatt is the pattern (if any) to use.
+        # Reverse scan?
+        my $Srev     = defined $should_reverse;
+        # No args - print all subs.
+        my $Snocheck = !defined $print_all_subs;
+
+        # Need to make these sane here.
+        local $\ = '';
+        local $, = '';
+
+        # Search through the debugger's magical hash of subs.
+        # If $nocheck is true, just print the sub name.
+        # Otherwise, check it against the pattern. We then use
+        # the XOR trick to reverse the condition as required.
+        foreach $subname ( sort( keys %sub ) ) {
+            if ( $Snocheck or $Srev ^ ( $subname =~ /$Spatt/ ) ) {
+                print $OUT $subname, "\n";
+            }
+        }
+        next CMD;
     }
 
     return;
 }
 
-sub _handle_sh_command {
+sub _handle_V_command_and_X_command {
     my $self = shift;
 
-    # $sh$sh - run a shell command (if it's all ASCII).
-    # Can't run shell commands with Unicode in the debugger, hmm.
-    my $my_cmd = $DB::cmd;
-    if ($my_cmd =~ m#\A$sh#gms) {
+    $DB::cmd =~ s/^X\b/V $DB::package/;
 
-        if ($my_cmd =~ m#\G\z#cgms) {
-            # Run the user's shell. If none defined, run Bourne.
-            # We resume execution when the shell terminates.
-            DB::_db_system( $ENV{SHELL} || "/bin/sh" );
-            next CMD;
-        }
-        elsif ($my_cmd =~ m#\G$sh\s*(.*)#cgms) {
-            # System it.
-            DB::_db_system($1);
-            next CMD;
-        }
-        elsif ($my_cmd =~ m#\G\s*(.*)#cgms) {
-            DB::_db_system( $ENV{SHELL} || "/bin/sh", "-c", $1 );
-            next CMD;
-        }
+    # Bare V commands get the currently-being-debugged package
+    # added.
+    if ($self->_is_full('V')) {
+        $DB::cmd = "V $DB::package";
     }
-}
 
-sub _handle_x_command {
-    my $self = shift;
+    # V - show variables in package.
+    if (my ($new_packname, $new_vars_str) =
+        $DB::cmd =~ /\AV\b\s*(\S+)\s*(.*)/) {
 
-    if ($DB::cmd =~ s#\Ax\b# #) {    # Remainder gets done by DB::eval()
-        $onetimeDump = 'dump';    # main::dumpvar shows the output
+        # Save the currently selected filehandle and
+        # force output to debugger's filehandle (dumpvar
+        # just does "print" for output).
+        my $savout = select($OUT);
 
-        # handle special  "x 3 blah" syntax XXX propagate
-        # doc back to special variables.
-        if ( $DB::cmd =~ s#\A\s*(\d+)(?=\s)# #) {
-            $onetimedumpDepth = $1;
-        }
-    }
+        # Grab package name and variables to dump.
+        $packname = $new_packname;
+        my @vars     = split( ' ', $new_vars_str );
 
-    return;
-}
+        # If main::dumpvar isn't here, get it.
+        do 'dumpvar.pl' || die $@ unless defined &main::dumpvar;
+        if ( defined &main::dumpvar ) {
 
-sub _handle_q_command {
-    my $self = shift;
+            # We got it. Turn off subroutine entry/exit messages
+            # for the moment, along with return values.
+            local $frame = 0;
+            local $doret = -2;
 
-    if ($self->_is_full('q')) {
-        $fall_off_end = 1;
-        DB::clean_ENV();
-        exit $?;
+            # must detect sigpipe failures  - not catching
+            # then will cause the debugger to die.
+            eval {
+                main::dumpvar(
+                    $packname,
+                    defined $option{dumpDepth}
+                    ? $option{dumpDepth}
+                    : -1,    # assume -1 unless specified
+                    @vars
+                );
+            };
+
+            # The die doesn't need to include the $@, because
+            # it will automatically get propagated for us.
+            if ($@) {
+                die unless $@ =~ /dumpvar print failed/;
+            }
+        } ## end if (defined &main::dumpvar)
+        else {
+
+            # Couldn't load dumpvar.
+            print $OUT "dumpvar.pl not available.\n";
+        }
+
+        # Restore the output filehandle, and go round again.
+        select($savout);
+        next CMD;
     }
 
     return;
 }
 
-sub _handle_cmd_wrapper_commands {
+sub _handle_dash_command {
     my $self = shift;
 
-    DB::cmd_wrapper( $self->cmd_verb, $self->cmd_args, $line );
-    next CMD;
-}
+    if ($self->_is_full('-')) {
 
-sub _handle_special_char_cmd_wrapper_commands {
-    my $self = shift;
+        # back up by a window; go to 1 if back too far.
+        $start -= $incr + $window + 1;
+        $start = 1 if $start <= 0;
+        $incr  = $window - 1;
 
-    # All of these commands were remapped in perl 5.8.0;
-    # we send them off to the secondary dispatcher (see below).
-    if (my ($cmd_letter, $my_arg) = $DB::cmd =~ /\A([<>\{]{1,2})\s*(.*)/so) {
-        DB::cmd_wrapper( $cmd_letter, $my_arg, $line );
-        next CMD;
+        # Generate and execute a "l +" command (handled below).
+        $DB::cmd = 'l ' . ($start) . '+';
+        redo CMD;
     }
-
     return;
 }
 
-} ## end DB::Obj
-
-package DB;
-
-# The following code may be executed now:
-# BEGIN {warn 4}
+sub _n_or_s_commands_generic {
+    my ($self, $new_val) = @_;
+    # n - next
+    next CMD if DB::_DB__is_finished();
 
-=head2 sub
+    # Single step, but don't enter subs.
+    $single = $new_val;
 
-C<sub> is called whenever a subroutine call happens in the program being
-debugged. The variable C<$DB::sub> contains the name of the subroutine
-being called.
+    # Save for empty command (repeat last).
+    $laststep = $DB::cmd;
+    last CMD;
+}
 
-The core function of this subroutine is to actually call the sub in the proper
-context, capturing its output. This of course causes C<DB::DB> to get called
-again, repeating until the subroutine ends and returns control to C<DB::sub>
-again. Once control returns, C<DB::sub> figures out whether or not to dump the
-return value, and returns its captured copy of the return value as its own
-return value. The value then feeds back into the program being debugged as if
-C<DB::sub> hadn't been there at all.
+sub _n_or_s {
+    my ($self, $letter, $new_val) = @_;
 
-C<sub> does all the work of printing the subroutine entry and exit messages
-enabled by setting C<$frame>. It notes what sub the autoloader got called for,
-and also prints the return value if needed (for the C<r> command and if
-the 16 bit is set in C<$frame>).
+    if ($self->_is_full($letter)) {
+        $self->_n_or_s_commands_generic($new_val);
+    }
+    else {
+        $self->_n_or_s_and_arg_commands_generic($letter, $new_val);
+    }
 
-It also tracks the subroutine call depth by saving the current setting of
-C<$single> in the C<@stack> package global; if this exceeds the value in
-C<$deep>, C<sub> automatically turns on printing of the current depth by
-setting the C<4> bit in C<$single>. In any case, it keeps the current setting
-of stop/don't stop on entry to subs set as it currently is set.
+    return;
+}
 
-=head3 C<caller()> support
+sub _handle_n_command {
+    my $self = shift;
 
-If C<caller()> is called from the package C<DB>, it provides some
-additional data, in the following order:
+    return $self->_n_or_s('n', 2);
+}
 
-=over 4
+sub _handle_s_command {
+    my $self = shift;
 
-=item * C<$package>
+    return $self->_n_or_s('s', 1);
+}
 
-The package name the sub was in
+sub _handle_r_command {
+    my $self = shift;
 
-=item * C<$filename>
+    # r - return from the current subroutine.
+    if ($self->_is_full('r')) {
 
-The filename it was defined in
+        # Can't do anything if the program's over.
+        next CMD if DB::_DB__is_finished();
 
-=item * C<$line>
+        # Turn on stack trace.
+        $stack[$stack_depth] |= 1;
 
-The line number it was defined on
+        # Print return value unless the stack is empty.
+        $doret = $option{PrintRet} ? $stack_depth - 1 : -2;
+        last CMD;
+    }
 
-=item * C<$subroutine>
+    return;
+}
 
-The subroutine name; C<(eval)> if an C<eval>().
+sub _handle_T_command {
+    my $self = shift;
 
-=item * C<$hasargs>
+    if ($self->_is_full('T')) {
+        DB::print_trace( $OUT, 1 );    # skip DB
+        next CMD;
+    }
 
-1 if it has arguments, 0 if not
+    return;
+}
 
-=item * C<$wantarray>
+sub _handle_w_command {
+    my $self = shift;
 
-1 if array context, 0 if scalar context
+    DB::cmd_w( 'w', $self->cmd_args() );
+    next CMD;
 
-=item * C<$evaltext>
+    return;
+}
 
-The C<eval>() text, if any (undefined for C<eval BLOCK>)
+sub _handle_W_command {
+    my $self = shift;
 
-=item * C<$is_require>
+    if (my $arg = $self->cmd_args) {
+        DB::cmd_W( 'W', $arg );
+        next CMD;
+    }
 
-frame was created by a C<use> or C<require> statement
+    return;
+}
 
-=item * C<$hints>
+sub _handle_rc_recall_command {
+    my $self = shift;
 
-pragma information; subject to change between versions
+    # $rc - recall command.
+    if (my ($minus, $arg) = $DB::cmd =~ m#\A$rc+\s*(-)?(\d+)?\z#) {
 
-=item * C<$bitmask>
+        # No arguments, take one thing off history.
+        pop(@hist) if length($DB::cmd) > 1;
 
-pragma information; subject to change between versions
+        # Relative (- found)?
+        #  Y - index back from most recent (by 1 if bare minus)
+        #  N - go to that particular command slot or the last
+        #      thing if nothing following.
 
-=item * C<@DB::args>
+        $self->cmd_verb(
+            scalar($minus ? ( $#hist - ( $arg || 1 ) ) : ( $arg || $#hist ))
+        );
 
-arguments with which the subroutine was invoked
+        # Pick out the command desired.
+        $DB::cmd = $hist[$self->cmd_verb];
 
-=back
+        # Print the command to be executed and restart the loop
+        # with that command in the buffer.
+        print {$OUT} $DB::cmd, "\n";
+        redo CMD;
+    }
 
-=cut
+    return;
+}
 
-use vars qw($deep);
+sub _handle_rc_search_history_command {
+    my $self = shift;
 
-# We need to fully qualify the name ("DB::sub") to make "use strict;"
-# happy. -- Shlomi Fish
+    # $rc pattern $rc - find a command in the history.
+    if (my ($arg) = $DB::cmd =~ /\A$rc([^$rc].*)\z/) {
 
-sub _indent_print_line_info {
-    my ($offset, $str) = @_;
+        # Create the pattern to use.
+        my $pat = "^$arg";
+        $self->pat($pat);
 
-    print_lineinfo( ' ' x ($stack_depth - $offset), $str);
+        # Toss off last entry if length is >1 (and it always is).
+        pop(@hist) if length($DB::cmd) > 1;
 
-    return;
-}
+        my $i;
 
-sub _print_frame_message {
-    my ($al) = @_;
+        # Look backward through the history.
+        SEARCH_HIST:
+        for ( $i = $#hist ; $i ; --$i ) {
+            # Stop if we find it.
+            last SEARCH_HIST if $hist[$i] =~ /$pat/;
+        }
 
-    if ($frame) {
-        if ($frame & 4) {   # Extended frame entry message
-            _indent_print_line_info(-1, "in  ");
+        if ( !$i ) {
 
-            # Why -1? But it works! :-(
-            # Because print_trace will call add 1 to it and then call
-            # dump_trace; this results in our skipping -1+1 = 0 stack frames
-            # in dump_trace.
-            #
-            # Now it's 0 because we extracted a function.
-            print_trace( $LINEINFO, 0, 1, 1, "$sub$al" );
-        }
-        else {
-            _indent_print_line_info(-1, "entering $sub$al\n" );
+            # Never found it.
+            print $OUT "No such command!\n\n";
+            next CMD;
         }
+
+        # Found it. Put it in the buffer, print it, and process it.
+        $DB::cmd = $hist[$i];
+        print $OUT $DB::cmd, "\n";
+        redo CMD;
     }
 
     return;
 }
 
-sub DB::sub {
-    my ( $al, $ret, @ret ) = "";
+sub _handle_H_command {
+    my $self = shift;
 
-    # We stack the stack pointer and then increment it to protect us
-    # from a situation that might unwind a whole bunch of call frames
-    # at once. Localizing the stack pointer means that it will automatically
-    # unwind the same amount when multiple stack frames are unwound.
-    local $stack_depth = $stack_depth + 1;    # Protect from non-local exits
+    if ($self->cmd_args =~ m#\A\*#) {
+        @hist = @truehist = ();
+        print $OUT "History cleansed\n";
+        next CMD;
+    }
 
-    {
-        # lock ourselves under threads
-        # While lock() permits recursive locks, there's two cases where it's bad
-        # that we keep a hold on the lock while we call the sub:
-        #  - during cloning, Package::CLONE might be called in the context of the new
-        #    thread, which will deadlock if we hold the lock across the threads::new call
-        #  - for any function that waits any significant time
-        # This also deadlocks if the parent thread joins(), since holding the lock
-        # will prevent any child threads passing this point.
-        # So release the lock for the function call.
-        lock($DBGR);
+    if (my ($num) = $self->cmd_args =~ /\A(?:-(\d+))?/) {
 
-        # Whether or not the autoloader was running, a scalar to put the
-        # sub's return value in (if needed), and an array to put the sub's
-        # return value in (if needed).
-        if ($sub eq 'threads::new' && $ENV{PERL5DB_THREADED}) {
-            print "creating new thread\n";
-        }
+        # Anything other than negative numbers is ignored by
+        # the (incorrect) pattern, so this test does nothing.
+        $end = $num ? ( $#hist - $num ) : 0;
 
-        # If the last ten characters are '::AUTOLOAD', note we've traced
-        # into AUTOLOAD for $sub.
-        if ( length($sub) > 10 && substr( $sub, -10, 10 ) eq '::AUTOLOAD' ) {
-            no strict 'refs';
-            $al = " for $$sub" if defined $$sub;
-        }
+        # Set to the minimum if less than zero.
+        $hist = 0 if $hist < 0;
 
-        # Expand @stack.
-        $#stack = $stack_depth;
+        # Start at the end of the array.
+        # Stay in while we're still above the ending value.
+        # Tick back by one each time around the loop.
+        my $i;
 
-        # Save current single-step setting.
-        $stack[-1] = $single;
+        for ( $i = $#hist ; $i > $end ; $i-- ) {
+            print $OUT "$i: ", $hist[$i], "\n";
+        }
 
-        # Turn off all flags except single-stepping.
-        $single &= 1;
+        next CMD;
+    }
 
-        # If we've gotten really deeply recursed, turn on the flag that will
-        # make us stop with the 'deep recursion' message.
-        $single |= 4 if $stack_depth == $deep;
+    return;
+}
 
-        # If frame messages are on ...
+sub _handle_doc_command {
+    my $self = shift;
 
-        _print_frame_message($al);
+    # man, perldoc, doc - show manual pages.
+    if (my ($man_page)
+        = $DB::cmd =~ /\A(?:man|(?:perl)?doc)\b(?:\s+([^(]*))?\z/) {
+        DB::runman($man_page);
+        next CMD;
     }
 
-    # Determine the sub's return type, and capture appropriately.
-    if (wantarray) {
+    return;
+}
 
-        # Called in array context. call sub and capture output.
-        # DB::DB will recursively get control again if appropriate; we'll come
-        # back here when the sub is finished.
-        no strict 'refs';
-        @ret = &$sub;
-    }
-    elsif ( defined wantarray ) {
-        no strict 'refs';
-        # Save the value if it's wanted at all.
-        $ret = &$sub;
+sub _handle_p_command {
+    my $self = shift;
+
+    my $print_cmd = 'print {$DB::OUT} ';
+    # p - print (no args): print $_.
+    if ($self->_is_full('p')) {
+        $DB::cmd = $print_cmd . '$_';
     }
     else {
-        no strict 'refs';
-        # Void return, explicitly.
-        &$sub;
-        undef $ret;
+        # p - print the given expression.
+        $DB::cmd =~ s/\Ap\b/$print_cmd /;
     }
 
-    {
-        lock($DBGR);
+    return;
+}
 
-        # Pop the single-step value back off the stack.
-        $single |= $stack[ $stack_depth-- ];
+sub _handle_equal_sign_command {
+    my $self = shift;
 
-        if ($frame & 2) {
-            if ($frame & 4) {   # Extended exit message
-                _indent_print_line_info(0, "out ");
-                print_trace( $LINEINFO, -1, 1, 1, "$sub$al" );
-            }
-            else {
-                _indent_print_line_info(0, "exited $sub$al\n" );
-            }
+    if ($DB::cmd =~ s/\A=\s*//) {
+        my @keys;
+        if ( length $DB::cmd == 0 ) {
+
+            # No args, get current aliases.
+            @keys = sort keys %alias;
         }
+        elsif ( my ( $k, $v ) = ( $DB::cmd =~ /^(\S+)\s+(\S.*)/ ) ) {
 
-        if (wantarray) {
-            # Print the return info if we need to.
-            if ( $doret eq $stack_depth or $frame & 16 ) {
+            # Creating a new alias. $k is alias name, $v is
+            # alias value.
+
+            # can't use $_ or kill //g state
+            for my $x ( $k, $v ) {
+
+                # Escape "alarm" characters.
+                $x =~ s/\a/\\a/g;
+            }
+
+            # Substitute key for value, using alarm chars
+            # as separators (which is why we escaped them in
+            # the command).
+            $alias{$k} = "s\a$k\a$v\a";
+
+            # Turn off standard warn and die behavior.
+            local $SIG{__DIE__};
+            local $SIG{__WARN__};
 
-                # Turn off output record separator.
-                local $\ = '';
-                my $fh = ( $doret eq $stack_depth ? $OUT : $LINEINFO );
+            # Is it valid Perl?
+            unless ( eval "sub { s\a$k\a$v\a }; 1" ) {
 
-                # Indent if we're printing because of $frame tracing.
-                if ($frame & 16)
-                  {
-                      print {$fh} ' ' x $stack_depth;
-                  }
+                # Nope. Bad alias. Say so and get out.
+                print $OUT "Can't alias $k to $v: $@\n";
+                delete $alias{$k};
+                next CMD;
+            }
 
-                # Print the return value.
-                print {$fh} "list context return from $sub:\n";
-                dumpit( $fh, \@ret );
+            # We'll only list the new one.
+            @keys = ($k);
+        } ## end elsif (my ($k, $v) = ($DB::cmd...
 
-                # And don't print it again.
-                $doret = -2;
-            } ## end if ($doret eq $stack_depth...
-            # And we have to return the return value now.
-            @ret;
-        } ## end if (wantarray)
-        # Scalar context.
+        # The argument is the alias to list.
         else {
-            # If we are supposed to show the return value... same as before.
-            if ( $doret eq $stack_depth or $frame & 16 and defined wantarray ) {
-                local $\ = '';
-                my $fh = ( $doret eq $stack_depth ? $OUT : $LINEINFO );
-                print $fh ( ' ' x $stack_depth ) if $frame & 16;
-                print $fh (
-                           defined wantarray
-                           ? "scalar context return from $sub: "
-                           : "void context return from $sub\n"
-                          );
-                dumpit( $fh, $ret ) if defined wantarray;
-                $doret = -2;
-            } ## end if ($doret eq $stack_depth...
+            @keys = ($DB::cmd);
+        }
 
-            # Return the appropriate scalar value.
-            $ret;
-        } ## end else [ if (wantarray)
-    }
-} ## end sub _sub
+        # List aliases.
+        for my $k (@keys) {
 
-sub lsub : lvalue {
+            # Messy metaquoting: Trim the substitution code off.
+            # We use control-G as the delimiter because it's not
+            # likely to appear in the alias.
+            if ( ( my $v = $alias{$k} ) =~ s\as\a$k\a(.*)\a$\a1\a ) {
 
-    # We stack the stack pointer and then increment it to protect us
-    # from a situation that might unwind a whole bunch of call frames
-    # at once. Localizing the stack pointer means that it will automatically
-    # unwind the same amount when multiple stack frames are unwound.
-    local $stack_depth = $stack_depth + 1;    # Protect from non-local exits
+                # Print the alias.
+                print $OUT "$k\t= $1\n";
+            }
+            elsif ( defined $alias{$k} ) {
 
-    # Expand @stack.
-    $#stack = $stack_depth;
+                # Couldn't trim it off; just print the alias code.
+                print $OUT "$k\t$alias{$k}\n";
+            }
+            else {
 
-    # Save current single-step setting.
-    $stack[-1] = $single;
+                # No such, dude.
+                print "No alias for $k\n";
+            }
+        } ## end for my $k (@keys)
+        next CMD;
+    }
 
-    # Turn off all flags except single-stepping.
-    # Use local so the single-step value is popped back off the
-    # stack for us.
-    local $single = $single & 1;
+    return;
+}
 
-    no strict 'refs';
-    {
-        # lock ourselves under threads
-        lock($DBGR);
+sub _handle_source_command {
+    my $self = shift;
 
-        # Whether or not the autoloader was running, a scalar to put the
-        # sub's return value in (if needed), and an array to put the sub's
-        # return value in (if needed).
-        my ( $al, $ret, @ret ) = "";
-        if ($sub =~ /^threads::new$/ && $ENV{PERL5DB_THREADED}) {
-            print "creating new thread\n";
-        }
+    # source - read commands from a file (or pipe!) and execute.
+    if (my $sourced_fn = $self->cmd_args) {
+        if ( open my $fh, $sourced_fn ) {
 
-        # If the last ten characters are C'::AUTOLOAD', note we've traced
-        # into AUTOLOAD for $sub.
-        if ( length($sub) > 10 && substr( $sub, -10, 10 ) eq '::AUTOLOAD' ) {
-            $al = " for $$sub";
+            # Opened OK; stick it in the list of file handles.
+            push @cmdfhs, $fh;
         }
+        else {
 
-        # If we've gotten really deeply recursed, turn on the flag that will
-        # make us stop with the 'deep recursion' message.
-        $single |= 4 if $stack_depth == $deep;
-
-        # If frame messages are on ...
-        _print_frame_message($al);
+            # Couldn't open it.
+            DB::_db_warn("Can't execute '$sourced_fn': $!\n");
+        }
+        next CMD;
     }
 
-    # call the original lvalue sub.
-    &$sub;
+    return;
 }
 
-# Abstracting common code from multiple places elsewhere:
-sub depth_print_lineinfo {
-    my $always_print = shift;
+sub _handle_enable_disable_commands {
+    my $self = shift;
 
-    print_lineinfo( @_ ) if ($always_print or $stack_depth < $trace_to_depth);
-}
+    my $which_cmd = $self->cmd_verb;
+    my $position = $self->cmd_args;
 
-=head1 EXTENDED COMMAND HANDLING AND THE COMMAND API
+    if ($position !~ /\s/) {
+        my ($fn, $line_num);
+        if ($position =~ m{\A\d+\z})
+        {
+            $fn = $DB::filename;
+            $line_num = $position;
+        }
+        elsif (my ($new_fn, $new_line_num)
+            = $position =~ m{\A(.*):(\d+)\z}) {
+            ($fn, $line_num) = ($new_fn, $new_line_num);
+        }
+        else
+        {
+            DB::_db_warn("Wrong spec for enable/disable argument.\n");
+        }
 
-In Perl 5.8.0, there was a major realignment of the commands and what they did,
-Most of the changes were to systematize the command structure and to eliminate
-commands that threw away user input without checking.
+        if (defined($fn)) {
+            if (DB::_has_breakpoint_data_ref($fn, $line_num)) {
+                DB::_set_breakpoint_enabled_status($fn, $line_num,
+                    ($which_cmd eq 'enable' ? 1 : '')
+                );
+            }
+            else {
+                DB::_db_warn("No breakpoint set at ${fn}:${line_num}\n");
+            }
+        }
 
-The following sections describe the code added to make it easy to support
-multiple command sets with conflicting command names. This section is a start
-at unifying all command processing to make it simpler to develop commands.
+        next CMD;
+    }
 
-Note that all the cmd_[a-zA-Z] subroutines require the command name, a line
-number, and C<$dbline> (the current line) as arguments.
+    return;
+}
 
-Support functions in this section which have multiple modes of failure C<die>
-on error; the rest simply return a false value.
+sub _handle_save_command {
+    my $self = shift;
 
-The user-interface functions (all of the C<cmd_*> functions) just output
-error messages.
+    if (my $new_fn = $self->cmd_args) {
+        my $filename = $new_fn || '.perl5dbrc';    # default?
+        if ( open my $fh, '>', $filename ) {
 
-=head2 C<%set>
+            # chomp to remove extraneous newlines from source'd files
+            chomp( my @truelist =
+                map { m/\A\s*(save|source)/ ? "#$_" : $_ }
+                @truehist );
+            print {$fh} join( "\n", @truelist );
+            print "commands saved in $filename\n";
+        }
+        else {
+            DB::_db_warn("Can't save debugger commands in '$new_fn': $!\n");
+        }
+        next CMD;
+    }
 
-The C<%set> hash defines the mapping from command letter to subroutine
-name suffix.
+    return;
+}
 
-C<%set> is a two-level hash, indexed by set name and then by command name.
-Note that trying to set the CommandSet to C<foobar> simply results in the
-5.8.0 command set being used, since there's no top-level entry for C<foobar>.
+sub _n_or_s_and_arg_commands_generic {
+    my ($self, $letter, $new_val) = @_;
 
-=cut
+    # s - single-step. Remember the last command was 's'.
+    if ($DB::cmd =~ s#\A\Q$letter\E\s#\$DB::single = $new_val;\n#) {
+        $laststep = $letter;
+    }
 
-### The API section
+    return;
+}
 
-my %set = (    #
-    'pre580' => {
-        'a' => 'pre580_a',
-        'A' => 'pre580_null',
-        'b' => 'pre580_b',
-        'B' => 'pre580_null',
-        'd' => 'pre580_null',
-        'D' => 'pre580_D',
-        'h' => 'pre580_h',
-        'M' => 'pre580_null',
-        'O' => 'o',
-        'o' => 'pre580_null',
-        'v' => 'M',
-        'w' => 'v',
-        'W' => 'pre580_W',
-    },
-    'pre590' => {
-        '<'  => 'pre590_prepost',
-        '<<' => 'pre590_prepost',
-        '>'  => 'pre590_prepost',
-        '>>' => 'pre590_prepost',
-        '{'  => 'pre590_prepost',
-        '{{' => 'pre590_prepost',
-    },
-);
+sub _handle_sh_command {
+    my $self = shift;
 
-my %breakpoints_data;
+    # $sh$sh - run a shell command (if it's all ASCII).
+    # Can't run shell commands with Unicode in the debugger, hmm.
+    my $my_cmd = $DB::cmd;
+    if ($my_cmd =~ m#\A$sh#gms) {
+
+        if ($my_cmd =~ m#\G\z#cgms) {
+            # Run the user's shell. If none defined, run Bourne.
+            # We resume execution when the shell terminates.
+            DB::_db_system( $ENV{SHELL} || "/bin/sh" );
+            next CMD;
+        }
+        elsif ($my_cmd =~ m#\G$sh\s*(.*)#cgms) {
+            # System it.
+            DB::_db_system($1);
+            next CMD;
+        }
+        elsif ($my_cmd =~ m#\G\s*(.*)#cgms) {
+            DB::_db_system( $ENV{SHELL} || "/bin/sh", "-c", $1 );
+            next CMD;
+        }
+    }
+}
 
-sub _has_breakpoint_data_ref {
-    my ($filename, $line) = @_;
+sub _handle_x_command {
+    my $self = shift;
 
-    return (
-        exists( $breakpoints_data{$filename} )
-            and
-        exists( $breakpoints_data{$filename}{$line} )
-    );
-}
+    if ($DB::cmd =~ s#\Ax\b# #) {    # Remainder gets done by DB::eval()
+        $onetimeDump = 'dump';    # main::dumpvar shows the output
 
-sub _get_breakpoint_data_ref {
-    my ($filename, $line) = @_;
+        # handle special  "x 3 blah" syntax XXX propagate
+        # doc back to special variables.
+        if ( $DB::cmd =~ s#\A\s*(\d+)(?=\s)# #) {
+            $onetimedumpDepth = $1;
+        }
+    }
 
-    return ($breakpoints_data{$filename}{$line} ||= +{});
+    return;
 }
 
-sub _delete_breakpoint_data_ref {
-    my ($filename, $line) = @_;
+sub _handle_q_command {
+    my $self = shift;
 
-    delete($breakpoints_data{$filename}{$line});
-    if (! scalar(keys( %{$breakpoints_data{$filename}} )) ) {
-        delete($breakpoints_data{$filename});
+    if ($self->_is_full('q')) {
+        $fall_off_end = 1;
+        DB::clean_ENV();
+        exit $?;
     }
 
     return;
 }
 
-sub _set_breakpoint_enabled_status {
-    my ($filename, $line, $status) = @_;
-
-    _get_breakpoint_data_ref($filename, $line)->{'enabled'} =
-        ($status ? 1 : '')
-        ;
+sub _handle_cmd_wrapper_commands {
+    my $self = shift;
 
-    return;
+    DB::cmd_wrapper( $self->cmd_verb, $self->cmd_args, $line );
+    next CMD;
 }
 
-sub _enable_breakpoint_temp_enabled_status {
-    my ($filename, $line) = @_;
+sub _handle_special_char_cmd_wrapper_commands {
+    my $self = shift;
 
-    _get_breakpoint_data_ref($filename, $line)->{'temp_enabled'} = 1;
+    # All of these commands were remapped in perl 5.8.0;
+    # we send them off to the secondary dispatcher (see below).
+    if (my ($cmd_letter, $my_arg) = $DB::cmd =~ /\A([<>\{]{1,2})\s*(.*)/so) {
+        DB::cmd_wrapper( $cmd_letter, $my_arg, $line );
+        next CMD;
+    }
 
     return;
 }
 
-sub _cancel_breakpoint_temp_enabled_status {
-    my ($filename, $line) = @_;
+} ## end DB::Obj
 
-    my $ref = _get_breakpoint_data_ref($filename, $line);
+package DB;
 
-    delete ($ref->{'temp_enabled'});
+# The following code may be executed now:
+# BEGIN {warn 4}
 
-    if (! %$ref) {
-        _delete_breakpoint_data_ref($filename, $line);
-    }
+=head2 sub
 
-    return;
-}
+C<sub> is called whenever a subroutine call happens in the program being
+debugged. The variable C<$DB::sub> contains the name of the subroutine
+being called.
 
-sub _is_breakpoint_enabled {
-    my ($filename, $line) = @_;
+The core function of this subroutine is to actually call the sub in the proper
+context, capturing its output. This of course causes C<DB::DB> to get called
+again, repeating until the subroutine ends and returns control to C<DB::sub>
+again. Once control returns, C<DB::sub> figures out whether or not to dump the
+return value, and returns its captured copy of the return value as its own
+return value. The value then feeds back into the program being debugged as if
+C<DB::sub> hadn't been there at all.
 
-    my $data_ref = _get_breakpoint_data_ref($filename, $line);
-    return ($data_ref->{'enabled'} || $data_ref->{'temp_enabled'});
-}
+C<sub> does all the work of printing the subroutine entry and exit messages
+enabled by setting C<$frame>. It notes what sub the autoloader got called for,
+and also prints the return value if needed (for the C<r> command and if
+the 16 bit is set in C<$frame>).
 
-=head2 C<cmd_wrapper()> (API)
+It also tracks the subroutine call depth by saving the current setting of
+C<$single> in the C<@stack> package global; if this exceeds the value in
+C<$deep>, C<sub> automatically turns on printing of the current depth by
+setting the C<4> bit in C<$single>. In any case, it keeps the current setting
+of stop/don't stop on entry to subs set as it currently is set.
 
-C<cmd_wrapper()> allows the debugger to switch command sets
-depending on the value of the C<CommandSet> option.
+=head3 C<caller()> support
 
-It tries to look up the command in the C<%set> package-level I<lexical>
-(which means external entities can't fiddle with it) and create the name of
-the sub to call based on the value found in the hash (if it's there). I<All>
-of the commands to be handled in a set have to be added to C<%set>; if they
-aren't found, the 5.8.0 equivalent is called (if there is one).
+If C<caller()> is called from the package C<DB>, it provides some
+additional data, in the following order:
 
-This code uses symbolic references.
+=over 4
 
-=cut
+=item * C<$package>
 
-sub cmd_wrapper {
-    my $cmd      = shift;
-    my $line     = shift;
-    my $dblineno = shift;
+The package name the sub was in
 
-    # Assemble the command subroutine's name by looking up the
-    # command set and command name in %set. If we can't find it,
-    # default to the older version of the command.
-    my $call = 'cmd_'
-      . ( $set{$CommandSet}{$cmd}
-          || ( $cmd =~ /\A[<>{]+/o ? 'prepost' : $cmd ) );
+=item * C<$filename>
 
-    # Call the command subroutine, call it by name.
-    return __PACKAGE__->can($call)->( $cmd, $line, $dblineno );
-} ## end sub cmd_wrapper
+The filename it was defined in
 
-=head3 C<cmd_a> (command)
+=item * C<$line>
 
-The C<a> command handles pre-execution actions. These are associated with a
-particular line, so they're stored in C<%dbline>. We default to the current
-line if none is specified.
+The line number it was defined on
 
-=cut
+=item * C<$subroutine>
 
-sub cmd_a {
-    my $cmd    = shift;
-    my $line   = shift || '';    # [.|line] expr
-    my $dbline = shift;
+The subroutine name; C<(eval)> if an C<eval>().
 
-    # If it's dot (here), or not all digits,  use the current line.
-    $line =~ s/\A\./$dbline/;
+=item * C<$hasargs>
 
-    # Should be a line number followed by an expression.
-    if ( my ($lineno, $expr) = $line =~ /^\s*(\d*)\s*(\S.+)/ ) {
+1 if it has arguments, 0 if not
 
-        if (! length($lineno)) {
-            $lineno = $dbline;
-        }
+=item * C<$wantarray>
 
-        # If we have an expression ...
-        if ( length $expr ) {
+1 if array context, 0 if scalar context
 
-            # ... but the line isn't breakable, complain.
-            if ( $dbline[$lineno] == 0 ) {
-                print $OUT
-                  "Line $lineno($dbline[$lineno]) does not have an action?\n";
-            }
-            else {
+=item * C<$evaltext>
 
-                # It's executable. Record that the line has an action.
-                $had_breakpoints{$filename} |= 2;
+The C<eval>() text, if any (undefined for C<eval BLOCK>)
 
-                # Remove any action, temp breakpoint, etc.
-                $dbline{$lineno} =~ s/\0[^\0]*//;
+=item * C<$is_require>
 
-                # Add the action to the line.
-                $dbline{$lineno} .= "\0" . action($expr);
+frame was created by a C<use> or C<require> statement
 
-                _set_breakpoint_enabled_status($filename, $lineno, 1);
-            }
-        } ## end if (length $expr)
-    } ## end if ($line =~ /^\s*(\d*)\s*(\S.+)/)
-    else {
+=item * C<$hints>
 
-        # Syntax wrong.
-        print $OUT
-          "Adding an action requires an optional lineno and an expression\n"
-          ;    # hint
-    }
-} ## end sub cmd_a
+pragma information; subject to change between versions
 
-=head3 C<cmd_A> (command)
+=item * C<$bitmask>
 
-Delete actions. Similar to above, except the delete code is in a separate
-subroutine, C<delete_action>.
+pragma information; subject to change between versions
 
-=cut
+=item * C<@DB::args>
 
-sub cmd_A {
-    my $cmd    = shift;
-    my $line   = shift || '';
-    my $dbline = shift;
+arguments with which the subroutine was invoked
 
-    # Dot is this line.
-    $line =~ s/^\./$dbline/;
+=back
 
-    # Call delete_action with a null param to delete them all.
-    # The '1' forces the eval to be true. It'll be false only
-    # if delete_action blows up for some reason, in which case
-    # we print $@ and get out.
-    if ( $line eq '*' ) {
-        if (! eval { _delete_all_actions(); 1 }) {
-            print {$OUT} $@;
-            return;
-        }
-    }
+=cut
 
-    # There's a real line  number. Pass it to delete_action.
-    # Error trapping is as above.
-    elsif ( $line =~ /^(\S.*)/ ) {
-        if (! eval { delete_action($1); 1 }) {
-            print {$OUT} $@;
-            return;
-        }
-    }
+use vars qw($deep);
 
-    # Swing and a miss. Bad syntax.
-    else {
-        print $OUT
-          "Deleting an action requires a line number, or '*' for all\n" ; # hint
-    }
-} ## end sub cmd_A
+# We need to fully qualify the name ("DB::sub") to make "use strict;"
+# happy. -- Shlomi Fish
 
-=head3 C<delete_action> (API)
+sub _indent_print_line_info {
+    my ($offset, $str) = @_;
 
-C<delete_action> accepts either a line number or C<undef>. If a line number
-is specified, we check for the line being executable (if it's not, it
-couldn't have had an  action). If it is, we just take the action off (this
-will get any kind of an action, including breakpoints).
+    print_lineinfo( ' ' x ($stack_depth - $offset), $str);
 
-=cut
+    return;
+}
 
-sub _remove_action_from_dbline {
-    my $i = shift;
+sub _print_frame_message {
+    my ($al) = @_;
 
-    $dbline{$i} =~ s/\0[^\0]*//;    # \^a
-    delete $dbline{$i} if $dbline{$i} eq '';
+    if ($frame) {
+        if ($frame & 4) {   # Extended frame entry message
+            _indent_print_line_info(-1, "in  ");
+
+            # Why -1? But it works! :-(
+            # Because print_trace will call add 1 to it and then call
+            # dump_trace; this results in our skipping -1+1 = 0 stack frames
+            # in dump_trace.
+            #
+            # Now it's 0 because we extracted a function.
+            print_trace( $LINEINFO, 0, 1, 1, "$sub$al" );
+        }
+        else {
+            _indent_print_line_info(-1, "entering $sub$al\n" );
+        }
+    }
 
     return;
 }
 
-sub _delete_all_actions {
-    print {$OUT} "Deleting all actions...\n";
+sub DB::sub {
+    my ( $al, $ret, @ret ) = "";
 
-    for my $file ( keys %had_breakpoints ) {
-        local *dbline = $main::{ '_<' . $file };
-        $max = $#dbline;
-        my $was;
-        for my $i (1 .. $max) {
-            if ( defined $dbline{$i} ) {
-                _remove_action_from_dbline($i);
-            }
+    # We stack the stack pointer and then increment it to protect us
+    # from a situation that might unwind a whole bunch of call frames
+    # at once. Localizing the stack pointer means that it will automatically
+    # unwind the same amount when multiple stack frames are unwound.
+    local $stack_depth = $stack_depth + 1;    # Protect from non-local exits
+
+    {
+        # lock ourselves under threads
+        # While lock() permits recursive locks, there's two cases where it's bad
+        # that we keep a hold on the lock while we call the sub:
+        #  - during cloning, Package::CLONE might be called in the context of the new
+        #    thread, which will deadlock if we hold the lock across the threads::new call
+        #  - for any function that waits any significant time
+        # This also deadlocks if the parent thread joins(), since holding the lock
+        # will prevent any child threads passing this point.
+        # So release the lock for the function call.
+        lock($DBGR);
+
+        # Whether or not the autoloader was running, a scalar to put the
+        # sub's return value in (if needed), and an array to put the sub's
+        # return value in (if needed).
+        if ($sub eq 'threads::new' && $ENV{PERL5DB_THREADED}) {
+            print "creating new thread\n";
         }
 
-        unless ( $had_breakpoints{$file} &= ~2 ) {
-            delete $had_breakpoints{$file};
+        # If the last ten characters are '::AUTOLOAD', note we've traced
+        # into AUTOLOAD for $sub.
+        if ( length($sub) > 10 && substr( $sub, -10, 10 ) eq '::AUTOLOAD' ) {
+            no strict 'refs';
+            $al = " for $$sub" if defined $$sub;
         }
-    }
 
-    return;
-}
+        # Expand @stack.
+        $#stack = $stack_depth;
 
-sub delete_action {
-    my $i = shift;
+        # Save current single-step setting.
+        $stack[-1] = $single;
 
-    if ( defined($i) ) {
-        # Can there be one?
-        die "Line $i has no action .\n" if $dbline[$i] == 0;
+        # Turn off all flags except single-stepping.
+        $single &= 1;
 
-        # Nuke whatever's there.
-        _remove_action_from_dbline($i);
+        # If we've gotten really deeply recursed, turn on the flag that will
+        # make us stop with the 'deep recursion' message.
+        $single |= 4 if $stack_depth == $deep;
+
+        # If frame messages are on ...
+
+        _print_frame_message($al);
+    }
+
+    # Determine the sub's return type, and capture appropriately.
+    if (wantarray) {
+
+        # Called in array context. call sub and capture output.
+        # DB::DB will recursively get control again if appropriate; we'll come
+        # back here when the sub is finished.
+        no strict 'refs';
+        @ret = &$sub;
+    }
+    elsif ( defined wantarray ) {
+        no strict 'refs';
+        # Save the value if it's wanted at all.
+        $ret = &$sub;
     }
     else {
-        _delete_all_actions();
+        no strict 'refs';
+        # Void return, explicitly.
+        &$sub;
+        undef $ret;
     }
-}
 
-=head3 C<cmd_b> (command)
+    {
+        lock($DBGR);
 
-Set breakpoints. Since breakpoints can be set in so many places, in so many
-ways, conditionally or not, the breakpoint code is kind of complex. Mostly,
-we try to parse the command type, and then shuttle it off to an appropriate
-subroutine to actually do the work of setting the breakpoint in the right
-place.
+        # Pop the single-step value back off the stack.
+        $single |= $stack[ $stack_depth-- ];
 
-=cut
+        if ($frame & 2) {
+            if ($frame & 4) {   # Extended exit message
+                _indent_print_line_info(0, "out ");
+                print_trace( $LINEINFO, -1, 1, 1, "$sub$al" );
+            }
+            else {
+                _indent_print_line_info(0, "exited $sub$al\n" );
+            }
+        }
 
-sub cmd_b {
-    my $cmd    = shift;
-    my $line   = shift;    # [.|line] [cond]
-    my $dbline = shift;
+        if (wantarray) {
+            # Print the return info if we need to.
+            if ( $doret eq $stack_depth or $frame & 16 ) {
 
-    my $default_cond = sub {
-        my $cond = shift;
-        return length($cond) ? $cond : '1';
-    };
+                # Turn off output record separator.
+                local $\ = '';
+                my $fh = ( $doret eq $stack_depth ? $OUT : $LINEINFO );
 
-    # Make . the current line number if it's there..
-    $line =~ s/^\.(\s|\z)/$dbline$1/;
+                # Indent if we're printing because of $frame tracing.
+                if ($frame & 16)
+                  {
+                      print {$fh} ' ' x $stack_depth;
+                  }
 
-    # No line number, no condition. Simple break on current line.
-    if ( $line =~ /^\s*$/ ) {
-        cmd_b_line( $dbline, 1 );
-    }
+                # Print the return value.
+                print {$fh} "list context return from $sub:\n";
+                dumpit( $fh, \@ret );
 
-    # Break on load for a file.
-    elsif ( my ($file) = $line =~ /^load\b\s*(.*)/ ) {
-        $file =~ s/\s+\z//;
-        cmd_b_load($file);
+                # And don't print it again.
+                $doret = -2;
+            } ## end if ($doret eq $stack_depth...
+            # And we have to return the return value now.
+            @ret;
+        } ## end if (wantarray)
+        # Scalar context.
+        else {
+            # If we are supposed to show the return value... same as before.
+            if ( $doret eq $stack_depth or $frame & 16 and defined wantarray ) {
+                local $\ = '';
+                my $fh = ( $doret eq $stack_depth ? $OUT : $LINEINFO );
+                print $fh ( ' ' x $stack_depth ) if $frame & 16;
+                print $fh (
+                           defined wantarray
+                           ? "scalar context return from $sub: "
+                           : "void context return from $sub\n"
+                          );
+                dumpit( $fh, $ret ) if defined wantarray;
+                $doret = -2;
+            } ## end if ($doret eq $stack_depth...
+
+            # Return the appropriate scalar value.
+            $ret;
+        } ## end else [ if (wantarray)
     }
+} ## end sub _sub
 
-    # b compile|postpone <some sub> [<condition>]
-    # The interpreter actually traps this one for us; we just put the
-    # necessary condition in the %postponed hash.
-    elsif ( my ($action, $subname, $cond)
-        = $line =~ /^(postpone|compile)\b\s*([':A-Za-z_][':\w]*)\s*(.*)/ ) {
+sub lsub : lvalue {
 
-        # De-Perl4-ify the name - ' separators to ::.
-        $subname =~ s/'/::/g;
+    # We stack the stack pointer and then increment it to protect us
+    # from a situation that might unwind a whole bunch of call frames
+    # at once. Localizing the stack pointer means that it will automatically
+    # unwind the same amount when multiple stack frames are unwound.
+    local $stack_depth = $stack_depth + 1;    # Protect from non-local exits
 
-        # Qualify it into the current package unless it's already qualified.
-        $subname = "${package}::" . $subname unless $subname =~ /::/;
+    # Expand @stack.
+    $#stack = $stack_depth;
 
-        # Add main if it starts with ::.
-        $subname = "main" . $subname if substr( $subname, 0, 2 ) eq "::";
+    # Save current single-step setting.
+    $stack[-1] = $single;
 
-        # Save the break type for this sub.
-        $postponed{$subname} = (($action eq 'postpone')
-            ? ( "break +0 if " . $default_cond->($cond) )
-            : "compile");
-    } ## end elsif ($line =~ ...
-    # b <filename>:<line> [<condition>]
-    elsif (my ($filename, $line_num, $cond)
-        = $line =~ /\A(\S+[^:]):(\d+)\s*(.*)/ms) {
-        cmd_b_filename_line(
-            $filename,
-            $line_num,
-            (length($cond) ? $cond : '1'),
-        );
-    }
-    # b <sub name> [<condition>]
-    elsif ( my ($new_subname, $new_cond) =
-        $line =~ /^([':A-Za-z_][':\w]*(?:\[.*\])?)\s*(.*)/ ) {
+    # Turn off all flags except single-stepping.
+    # Use local so the single-step value is popped back off the
+    # stack for us.
+    local $single = $single & 1;
 
-        #
-        $subname = $new_subname;
-        cmd_b_sub( $subname, $default_cond->($new_cond) );
-    }
+    no strict 'refs';
+    {
+        # lock ourselves under threads
+        lock($DBGR);
 
-    # b <line> [<condition>].
-    elsif ( my ($line_n, $cond) = $line =~ /^(\d*)\s*(.*)/ ) {
+        # Whether or not the autoloader was running, a scalar to put the
+        # sub's return value in (if needed), and an array to put the sub's
+        # return value in (if needed).
+        my ( $al, $ret, @ret ) = "";
+        if ($sub =~ /^threads::new$/ && $ENV{PERL5DB_THREADED}) {
+            print "creating new thread\n";
+        }
 
-        # Capture the line. If none, it's the current line.
-        $line = $line_n || $dbline;
+        # If the last ten characters are C'::AUTOLOAD', note we've traced
+        # into AUTOLOAD for $sub.
+        if ( length($sub) > 10 && substr( $sub, -10, 10 ) eq '::AUTOLOAD' ) {
+            $al = " for $$sub";
+        }
 
-        # Break on line.
-        cmd_b_line( $line, $default_cond->($cond) );
-    }
+        # If we've gotten really deeply recursed, turn on the flag that will
+        # make us stop with the 'deep recursion' message.
+        $single |= 4 if $stack_depth == $deep;
 
-    # Line didn't make sense.
-    else {
-        print "confused by line($line)?\n";
+        # If frame messages are on ...
+        _print_frame_message($al);
     }
 
-    return;
-} ## end sub cmd_b
+    # call the original lvalue sub.
+    &$sub;
+}
 
-=head3 C<break_on_load> (API)
+# Abstracting common code from multiple places elsewhere:
+sub depth_print_lineinfo {
+    my $always_print = shift;
 
-We want to break when this file is loaded. Mark this file in the
-C<%break_on_load> hash, and note that it has a breakpoint in
-C<%had_breakpoints>.
+    print_lineinfo( @_ ) if ($always_print or $stack_depth < $trace_to_depth);
+}
+
+=head1 EXTENDED COMMAND HANDLING AND THE COMMAND API
 
-=cut
+In Perl 5.8.0, there was a major realignment of the commands and what they did,
+Most of the changes were to systematize the command structure and to eliminate
+commands that threw away user input without checking.
 
-sub break_on_load {
-    my $file = shift;
-    $break_on_load{$file} = 1;
-    $had_breakpoints{$file} |= 1;
-}
+The following sections describe the code added to make it easy to support
+multiple command sets with conflicting command names. This section is a start
+at unifying all command processing to make it simpler to develop commands.
 
-=head3 C<report_break_on_load> (API)
+Note that all the cmd_[a-zA-Z] subroutines require the command name, a line
+number, and C<$dbline> (the current line) as arguments.
 
-Gives us an array of filenames that are set to break on load. Note that
-only files with break-on-load are in here, so simply showing the keys
-suffices.
+Support functions in this section which have multiple modes of failure C<die>
+on error; the rest simply return a false value.
 
-=cut
+The user-interface functions (all of the C<cmd_*> functions) just output
+error messages.
 
-sub report_break_on_load {
-    sort keys %break_on_load;
-}
+=head2 C<%set>
 
-=head3 C<cmd_b_load> (command)
+The C<%set> hash defines the mapping from command letter to subroutine
+name suffix.
 
-We take the file passed in and try to find it in C<%INC> (which maps modules
-to files they came from). We mark those files for break-on-load via
-C<break_on_load> and then report that it was done.
+C<%set> is a two-level hash, indexed by set name and then by command name.
+Note that trying to set the CommandSet to C<foobar> simply results in the
+5.8.0 command set being used, since there's no top-level entry for C<foobar>.
 
 =cut
 
-sub cmd_b_load {
-    my $file = shift;
-    my @files;
+### The API section
 
-    # This is a block because that way we can use a redo inside it
-    # even without there being any looping structure at all outside it.
-    {
+my %set = (    #
+    'pre580' => {
+        'a' => 'pre580_a',
+        'A' => 'pre580_null',
+        'b' => 'pre580_b',
+        'B' => 'pre580_null',
+        'd' => 'pre580_null',
+        'D' => 'pre580_D',
+        'h' => 'pre580_h',
+        'M' => 'pre580_null',
+        'O' => 'o',
+        'o' => 'pre580_null',
+        'v' => 'M',
+        'w' => 'v',
+        'W' => 'pre580_W',
+    },
+    'pre590' => {
+        '<'  => 'pre590_prepost',
+        '<<' => 'pre590_prepost',
+        '>'  => 'pre590_prepost',
+        '>>' => 'pre590_prepost',
+        '{'  => 'pre590_prepost',
+        '{{' => 'pre590_prepost',
+    },
+);
 
-        # Save short name and full path if found.
-        push @files, $file;
-        push @files, $::INC{$file} if $::INC{$file};
+my %breakpoints_data;
 
-        # Tack on .pm and do it again unless there was a '.' in the name
-        # already.
-        $file .= '.pm', redo unless $file =~ /\./;
-    }
+sub _has_breakpoint_data_ref {
+    my ($filename, $line) = @_;
 
-    # Do the real work here.
-    break_on_load($_) for @files;
+    return (
+        exists( $breakpoints_data{$filename} )
+            and
+        exists( $breakpoints_data{$filename}{$line} )
+    );
+}
 
-    # All the files that have break-on-load breakpoints.
-    @files = report_break_on_load;
+sub _get_breakpoint_data_ref {
+    my ($filename, $line) = @_;
 
-    # Normalize for the purposes of our printing this.
-    local $\ = '';
-    local $" = ' ';
-    print $OUT "Will stop on load of '@files'.\n";
-} ## end sub cmd_b_load
+    return ($breakpoints_data{$filename}{$line} ||= +{});
+}
 
-=head3 C<$filename_error> (API package global)
+sub _delete_breakpoint_data_ref {
+    my ($filename, $line) = @_;
 
-Several of the functions we need to implement in the API need to work both
-on the current file and on other files. We don't want to duplicate code, so
-C<$filename_error> is used to contain the name of the file that's being
-worked on (if it's not the current one).
+    delete($breakpoints_data{$filename}{$line});
+    if (! scalar(keys( %{$breakpoints_data{$filename}} )) ) {
+        delete($breakpoints_data{$filename});
+    }
 
-We can now build functions in pairs: the basic function works on the current
-file, and uses C<$filename_error> as part of its error message. Since this is
-initialized to C<"">, no filename will appear when we are working on the
-current file.
+    return;
+}
 
-The second function is a wrapper which does the following:
+sub _set_breakpoint_enabled_status {
+    my ($filename, $line, $status) = @_;
 
-=over 4
+    _get_breakpoint_data_ref($filename, $line)->{'enabled'} =
+        ($status ? 1 : '')
+        ;
 
-=item *
+    return;
+}
 
-Localizes C<$filename_error> and sets it to the name of the file to be processed.
+sub _enable_breakpoint_temp_enabled_status {
+    my ($filename, $line) = @_;
 
-=item *
+    _get_breakpoint_data_ref($filename, $line)->{'temp_enabled'} = 1;
 
-Localizes the C<*dbline> glob and reassigns it to point to the file we want to process.
+    return;
+}
 
-=item *
+sub _cancel_breakpoint_temp_enabled_status {
+    my ($filename, $line) = @_;
 
-Calls the first function.
+    my $ref = _get_breakpoint_data_ref($filename, $line);
 
-The first function works on the I<current> file (i.e., the one we changed to),
-and prints C<$filename_error> in the error message (the name of the other file)
-if it needs to. When the functions return, C<*dbline> is restored to point
-to the actual current file (the one we're executing in) and
-C<$filename_error> is restored to C<"">. This restores everything to
-the way it was before the second function was called at all.
+    delete ($ref->{'temp_enabled'});
 
-See the comments in C<breakable_line> and C<breakable_line_in_file> for more
-details.
+    if (! %$ref) {
+        _delete_breakpoint_data_ref($filename, $line);
+    }
 
-=back
+    return;
+}
 
-=cut
+sub _is_breakpoint_enabled {
+    my ($filename, $line) = @_;
 
-use vars qw($filename_error);
-$filename_error = '';
+    my $data_ref = _get_breakpoint_data_ref($filename, $line);
+    return ($data_ref->{'enabled'} || $data_ref->{'temp_enabled'});
+}
 
-=head3 breakable_line(from, to) (API)
+=head2 C<cmd_wrapper()> (API)
 
-The subroutine decides whether or not a line in the current file is breakable.
-It walks through C<@dbline> within the range of lines specified, looking for
-the first line that is breakable.
+C<cmd_wrapper()> allows the debugger to switch command sets
+depending on the value of the C<CommandSet> option.
 
-If C<$to> is greater than C<$from>, the search moves forwards, finding the
-first line I<after> C<$to> that's breakable, if there is one.
+It tries to look up the command in the C<%set> package-level I<lexical>
+(which means external entities can't fiddle with it) and create the name of
+the sub to call based on the value found in the hash (if it's there). I<All>
+of the commands to be handled in a set have to be added to C<%set>; if they
+aren't found, the 5.8.0 equivalent is called (if there is one).
 
-If C<$from> is greater than C<$to>, the search goes I<backwards>, finding the
-first line I<before> C<$to> that's breakable, if there is one.
+This code uses symbolic references.
 
 =cut
 
-sub breakable_line {
+sub cmd_wrapper {
+    my $cmd      = shift;
+    my $line     = shift;
+    my $dblineno = shift;
 
-    my ( $from, $to ) = @_;
+    # Assemble the command subroutine's name by looking up the
+    # command set and command name in %set. If we can't find it,
+    # default to the older version of the command.
+    my $call = 'cmd_'
+      . ( $set{$CommandSet}{$cmd}
+          || ( $cmd =~ /\A[<>{]+/o ? 'prepost' : $cmd ) );
 
-    # $i is the start point. (Where are the FORTRAN programs of yesteryear?)
-    my $i = $from;
+    # Call the command subroutine, call it by name.
+    return __PACKAGE__->can($call)->( $cmd, $line, $dblineno );
+} ## end sub cmd_wrapper
 
-    # If there are at least 2 arguments, we're trying to search a range.
-    if ( @_ >= 2 ) {
+=head3 C<cmd_a> (command)
 
-        # $delta is positive for a forward search, negative for a backward one.
-        my $delta = $from < $to ? +1 : -1;
+The C<a> command handles pre-execution actions. These are associated with a
+particular line, so they're stored in C<%dbline>. We default to the current
+line if none is specified.
 
-        # Keep us from running off the ends of the file.
-        my $limit = $delta > 0 ? $#dbline : 1;
+=cut
 
-        # Clever test. If you're a mathematician, it's obvious why this
-        # test works. If not:
-        # If $delta is positive (going forward), $limit will be $#dbline.
-        #    If $to is less than $limit, ($limit - $to) will be positive, times
-        #    $delta of 1 (positive), so the result is > 0 and we should use $to
-        #    as the stopping point.
-        #
-        #    If $to is greater than $limit, ($limit - $to) is negative,
-        #    times $delta of 1 (positive), so the result is < 0 and we should
-        #    use $limit ($#dbline) as the stopping point.
-        #
-        # If $delta is negative (going backward), $limit will be 1.
-        #    If $to is zero, ($limit - $to) will be 1, times $delta of -1
-        #    (negative) so the result is > 0, and we use $to as the stopping
-        #    point.
-        #
-        #    If $to is less than zero, ($limit - $to) will be positive,
-        #    times $delta of -1 (negative), so the result is not > 0, and
-        #    we use $limit (1) as the stopping point.
-        #
-        #    If $to is 1, ($limit - $to) will zero, times $delta of -1
-        #    (negative), still giving zero; the result is not > 0, and
-        #    we use $limit (1) as the stopping point.
-        #
-        #    if $to is >1, ($limit - $to) will be negative, times $delta of -1
-        #    (negative), giving a positive (>0) value, so we'll set $limit to
-        #    $to.
+sub cmd_a {
+    my $cmd    = shift;
+    my $line   = shift || '';    # [.|line] expr
+    my $dbline = shift;
 
-        $limit = $to if ( $limit - $to ) * $delta > 0;
+    # If it's dot (here), or not all digits,  use the current line.
+    $line =~ s/\A\./$dbline/;
 
-        # The real search loop.
-        # $i starts at $from (the point we want to start searching from).
-        # We move through @dbline in the appropriate direction (determined
-        # by $delta: either -1 (back) or +1 (ahead).
-        # We stay in as long as we haven't hit an executable line
-        # ($dbline[$i] == 0 means not executable) and we haven't reached
-        # the limit yet (test similar to the above).
-        $i += $delta while $dbline[$i] == 0 and ( $limit - $i ) * $delta > 0;
+    # Should be a line number followed by an expression.
+    if ( my ($lineno, $expr) = $line =~ /^\s*(\d*)\s*(\S.+)/ ) {
+
+        if (! length($lineno)) {
+            $lineno = $dbline;
+        }
+
+        # If we have an expression ...
+        if ( length $expr ) {
 
-    } ## end if (@_ >= 2)
+            # ... but the line isn't breakable, complain.
+            if ( $dbline[$lineno] == 0 ) {
+                print $OUT
+                  "Line $lineno($dbline[$lineno]) does not have an action?\n";
+            }
+            else {
 
-    # If $i points to a line that is executable, return that.
-    return $i unless $dbline[$i] == 0;
+                # It's executable. Record that the line has an action.
+                $had_breakpoints{$filename} |= 2;
 
-    # Format the message and print it: no breakable lines in range.
-    my ( $pl, $upto ) = ( '', '' );
-    ( $pl, $upto ) = ( 's', "..$to" ) if @_ >= 2 and $from != $to;
+                # Remove any action, temp breakpoint, etc.
+                $dbline{$lineno} =~ s/\0[^\0]*//;
 
-    # If there's a filename in filename_error, we'll see it.
-    # If not, not.
-    die "Line$pl $from$upto$filename_error not breakable\n";
-} ## end sub breakable_line
+                # Add the action to the line.
+                $dbline{$lineno} .= "\0" . action($expr);
 
-=head3 breakable_line_in_filename(file, from, to) (API)
+                _set_breakpoint_enabled_status($filename, $lineno, 1);
+            }
+        } ## end if (length $expr)
+    } ## end if ($line =~ /^\s*(\d*)\s*(\S.+)/)
+    else {
 
-Like C<breakable_line>, but look in another file.
+        # Syntax wrong.
+        print $OUT
+          "Adding an action requires an optional lineno and an expression\n"
+          ;    # hint
+    }
+} ## end sub cmd_a
 
-=cut
+=head3 C<cmd_A> (command)
 
-sub breakable_line_in_filename {
+Delete actions. Similar to above, except the delete code is in a separate
+subroutine, C<delete_action>.
 
-    # Capture the file name.
-    my ($f) = shift;
+=cut
 
-    # Swap the magic line array over there temporarily.
-    local *dbline = $main::{ '_<' . $f };
+sub cmd_A {
+    my $cmd    = shift;
+    my $line   = shift || '';
+    my $dbline = shift;
 
-    # If there's an error, it's in this other file.
-    local $filename_error = " of '$f'";
+    # Dot is this line.
+    $line =~ s/^\./$dbline/;
 
-    # Find the breakable line.
-    breakable_line(@_);
+    # Call delete_action with a null param to delete them all.
+    # The '1' forces the eval to be true. It'll be false only
+    # if delete_action blows up for some reason, in which case
+    # we print $@ and get out.
+    if ( $line eq '*' ) {
+        if (! eval { _delete_all_actions(); 1 }) {
+            print {$OUT} $@;
+            return;
+        }
+    }
 
-    # *dbline and $filename_error get restored when this block ends.
+    # There's a real line  number. Pass it to delete_action.
+    # Error trapping is as above.
+    elsif ( $line =~ /^(\S.*)/ ) {
+        if (! eval { delete_action($1); 1 }) {
+            print {$OUT} $@;
+            return;
+        }
+    }
 
-} ## end sub breakable_line_in_filename
+    # Swing and a miss. Bad syntax.
+    else {
+        print $OUT
+          "Deleting an action requires a line number, or '*' for all\n" ; # hint
+    }
+} ## end sub cmd_A
 
-=head3 break_on_line(lineno, [condition]) (API)
+=head3 C<delete_action> (API)
 
-Adds a breakpoint with the specified condition (or 1 if no condition was
-specified) to the specified line. Dies if it can't.
+C<delete_action> accepts either a line number or C<undef>. If a line number
+is specified, we check for the line being executable (if it's not, it
+couldn't have had an  action). If it is, we just take the action off (this
+will get any kind of an action, including breakpoints).
 
 =cut
 
-sub break_on_line {
+sub _remove_action_from_dbline {
     my $i = shift;
-    my $cond = @_ ? shift(@_) : 1;
 
-    my $inii  = $i;
-    my $after = '';
-    my $pl    = '';
+    $dbline{$i} =~ s/\0[^\0]*//;    # \^a
+    delete $dbline{$i} if $dbline{$i} eq '';
 
-    # Woops, not a breakable line. $filename_error allows us to say
-    # if it was in a different file.
-    die "Line $i$filename_error not breakable.\n" if $dbline[$i] == 0;
+    return;
+}
 
-    # Mark this file as having breakpoints in it.
-    $had_breakpoints{$filename} |= 1;
+sub _delete_all_actions {
+    print {$OUT} "Deleting all actions...\n";
 
-    # If there is an action or condition here already ...
-    if ( $dbline{$i} ) {
+    for my $file ( keys %had_breakpoints ) {
+        local *dbline = $main::{ '_<' . $file };
+        $max = $#dbline;
+        my $was;
+        for my $i (1 .. $max) {
+            if ( defined $dbline{$i} ) {
+                _remove_action_from_dbline($i);
+            }
+        }
 
-        # ... swap this condition for the existing one.
-        $dbline{$i} =~ s/^[^\0]*/$cond/;
+        unless ( $had_breakpoints{$file} &= ~2 ) {
+            delete $had_breakpoints{$file};
+        }
+    }
+
+    return;
+}
+
+sub delete_action {
+    my $i = shift;
+
+    if ( defined($i) ) {
+        # Can there be one?
+        die "Line $i has no action .\n" if $dbline[$i] == 0;
+
+        # Nuke whatever's there.
+        _remove_action_from_dbline($i);
     }
     else {
+        _delete_all_actions();
+    }
+}
 
-        # Nothing here - just add the condition.
-        $dbline{$i} = $cond;
+=head3 C<cmd_b> (command)
 
-        _set_breakpoint_enabled_status($filename, $i, 1);
+Set breakpoints. Since breakpoints can be set in so many places, in so many
+ways, conditionally or not, the breakpoint code is kind of complex. Mostly,
+we try to parse the command type, and then shuttle it off to an appropriate
+subroutine to actually do the work of setting the breakpoint in the right
+place.
+
+=cut
+
+sub cmd_b {
+    my $cmd    = shift;
+    my $line   = shift;    # [.|line] [cond]
+    my $dbline = shift;
+
+    my $default_cond = sub {
+        my $cond = shift;
+        return length($cond) ? $cond : '1';
+    };
+
+    # Make . the current line number if it's there..
+    $line =~ s/^\.(\s|\z)/$dbline$1/;
+
+    # No line number, no condition. Simple break on current line.
+    if ( $line =~ /^\s*$/ ) {
+        cmd_b_line( $dbline, 1 );
     }
 
-    return;
-} ## end sub break_on_line
+    # Break on load for a file.
+    elsif ( my ($file) = $line =~ /^load\b\s*(.*)/ ) {
+        $file =~ s/\s+\z//;
+        cmd_b_load($file);
+    }
 
-=head3 cmd_b_line(line, [condition]) (command)
+    # b compile|postpone <some sub> [<condition>]
+    # The interpreter actually traps this one for us; we just put the
+    # necessary condition in the %postponed hash.
+    elsif ( my ($action, $subname, $cond)
+        = $line =~ /^(postpone|compile)\b\s*([':A-Za-z_][':\w]*)\s*(.*)/ ) {
 
-Wrapper for C<break_on_line>. Prints the failure message if it
-doesn't work.
+        # De-Perl4-ify the name - ' separators to ::.
+        $subname =~ s/'/::/g;
 
-=cut
+        # Qualify it into the current package unless it's already qualified.
+        $subname = "${package}::" . $subname unless $subname =~ /::/;
 
-sub cmd_b_line {
-    if (not eval { break_on_line(@_); 1 }) {
-        local $\ = '';
-        print $OUT $@ and return;
+        # Add main if it starts with ::.
+        $subname = "main" . $subname if substr( $subname, 0, 2 ) eq "::";
+
+        # Save the break type for this sub.
+        $postponed{$subname} = (($action eq 'postpone')
+            ? ( "break +0 if " . $default_cond->($cond) )
+            : "compile");
+    } ## end elsif ($line =~ ...
+    # b <filename>:<line> [<condition>]
+    elsif (my ($filename, $line_num, $cond)
+        = $line =~ /\A(\S+[^:]):(\d+)\s*(.*)/ms) {
+        cmd_b_filename_line(
+            $filename,
+            $line_num,
+            (length($cond) ? $cond : '1'),
+        );
     }
+    # b <sub name> [<condition>]
+    elsif ( my ($new_subname, $new_cond) =
+        $line =~ /^([':A-Za-z_][':\w]*(?:\[.*\])?)\s*(.*)/ ) {
 
-    return;
-} ## end sub cmd_b_line
+        #
+        $subname = $new_subname;
+        cmd_b_sub( $subname, $default_cond->($new_cond) );
+    }
 
-=head3 cmd_b_filename_line(line, [condition]) (command)
+    # b <line> [<condition>].
+    elsif ( my ($line_n, $cond) = $line =~ /^(\d*)\s*(.*)/ ) {
 
-Wrapper for C<break_on_filename_line>. Prints the failure message if it
-doesn't work.
+        # Capture the line. If none, it's the current line.
+        $line = $line_n || $dbline;
 
-=cut
+        # Break on line.
+        cmd_b_line( $line, $default_cond->($cond) );
+    }
 
-sub cmd_b_filename_line {
-    if (not eval { break_on_filename_line(@_); 1 }) {
-        local $\ = '';
-        print $OUT $@ and return;
+    # Line didn't make sense.
+    else {
+        print "confused by line($line)?\n";
     }
 
     return;
-}
+} ## end sub cmd_b
 
-=head3 break_on_filename_line(file, line, [condition]) (API)
+=head3 C<break_on_load> (API)
 
-Switches to the file specified and then calls C<break_on_line> to set
-the breakpoint.
+We want to break when this file is loaded. Mark this file in the
+C<%break_on_load> hash, and note that it has a breakpoint in
+C<%had_breakpoints>.
 
 =cut
 
-sub break_on_filename_line {
-    my $f = shift;
-    my $i = shift;
-    my $cond = @_ ? shift(@_) : 1;
-
-    # Switch the magical hash temporarily.
-    local *dbline = $main::{ '_<' . $f };
+sub break_on_load {
+    my $file = shift;
+    $break_on_load{$file} = 1;
+    $had_breakpoints{$file} |= 1;
+}
 
-    # Localize the variables that break_on_line uses to make its message.
-    local $filename_error = " of '$f'";
-    local $filename       = $f;
+=head3 C<report_break_on_load> (API)
 
-    # Add the breakpoint.
-    break_on_line( $i, $cond );
+Gives us an array of filenames that are set to break on load. Note that
+only files with break-on-load are in here, so simply showing the keys
+suffices.
 
-    return;
-} ## end sub break_on_filename_line
+=cut
 
-=head3 break_on_filename_line_range(file, from, to, [condition]) (API)
+sub report_break_on_load {
+    sort keys %break_on_load;
+}
 
-Switch to another file, search the range of lines specified for an
-executable one, and put a breakpoint on the first one you find.
+=head3 C<cmd_b_load> (command)
+
+We take the file passed in and try to find it in C<%INC> (which maps modules
+to files they came from). We mark those files for break-on-load via
+C<break_on_load> and then report that it was done.
 
 =cut
 
-sub break_on_filename_line_range {
-    my $f = shift;
-    my $from = shift;
-    my $to = shift;
-    my $cond = @_ ? shift(@_) : 1;
+sub cmd_b_load {
+    my $file = shift;
+    my @files;
 
-    # Find a breakable line if there is one.
-    my $i = breakable_line_in_filename( $f, $from, $to );
+    # This is a block because that way we can use a redo inside it
+    # even without there being any looping structure at all outside it.
+    {
 
-    # Add the breakpoint.
-    break_on_filename_line( $f, $i, $cond );
+        # Save short name and full path if found.
+        push @files, $file;
+        push @files, $::INC{$file} if $::INC{$file};
 
-    return;
-} ## end sub break_on_filename_line_range
+        # Tack on .pm and do it again unless there was a '.' in the name
+        # already.
+        $file .= '.pm', redo unless $file =~ /\./;
+    }
 
-=head3 subroutine_filename_lines(subname, [condition]) (API)
+    # Do the real work here.
+    break_on_load($_) for @files;
 
-Search for a subroutine within a given file. The condition is ignored.
-Uses C<find_sub> to locate the desired subroutine.
+    # All the files that have break-on-load breakpoints.
+    @files = report_break_on_load;
 
-=cut
+    # Normalize for the purposes of our printing this.
+    local $\ = '';
+    local $" = ' ';
+    print $OUT "Will stop on load of '@files'.\n";
+} ## end sub cmd_b_load
 
-sub subroutine_filename_lines {
-    my ( $subname ) = @_;
+=head3 C<$filename_error> (API package global)
 
-    # Returned value from find_sub() is fullpathname:startline-endline.
-    # The match creates the list (fullpathname, start, end).
-    return (find_sub($subname) =~ /^(.*):(\d+)-(\d+)$/);
-} ## end sub subroutine_filename_lines
+Several of the functions we need to implement in the API need to work both
+on the current file and on other files. We don't want to duplicate code, so
+C<$filename_error> is used to contain the name of the file that's being
+worked on (if it's not the current one).
 
-=head3 break_subroutine(subname) (API)
+We can now build functions in pairs: the basic function works on the current
+file, and uses C<$filename_error> as part of its error message. Since this is
+initialized to C<"">, no filename will appear when we are working on the
+current file.
 
-Places a break on the first line possible in the specified subroutine. Uses
-C<subroutine_filename_lines> to find the subroutine, and
-C<break_on_filename_line_range> to place the break.
+The second function is a wrapper which does the following:
 
-=cut
+=over 4
 
-sub break_subroutine {
-    my $subname = shift;
+=item *
 
-    # Get filename, start, and end.
-    my ( $file, $s, $e ) = subroutine_filename_lines($subname)
-      or die "Subroutine $subname not found.\n";
+Localizes C<$filename_error> and sets it to the name of the file to be processed.
 
+=item *
 
-    # Null condition changes to '1' (always true).
-    my $cond = @_ ? shift(@_) : 1;
+Localizes the C<*dbline> glob and reassigns it to point to the file we want to process.
 
-    # Put a break the first place possible in the range of lines
-    # that make up this subroutine.
-    break_on_filename_line_range( $file, $s, $e, $cond );
+=item *
 
-    return;
-} ## end sub break_subroutine
+Calls the first function.
 
-=head3 cmd_b_sub(subname, [condition]) (command)
+The first function works on the I<current> file (i.e., the one we changed to),
+and prints C<$filename_error> in the error message (the name of the other file)
+if it needs to. When the functions return, C<*dbline> is restored to point
+to the actual current file (the one we're executing in) and
+C<$filename_error> is restored to C<"">. This restores everything to
+the way it was before the second function was called at all.
 
-We take the incoming subroutine name and fully-qualify it as best we can.
+See the comments in C<breakable_line> and C<breakable_line_in_file> for more
+details.
 
-=over 4
+=back
 
-=item 1. If it's already fully-qualified, leave it alone.
+=cut
 
-=item 2. Try putting it in the current package.
+use vars qw($filename_error);
+$filename_error = '';
 
-=item 3. If it's not there, try putting it in CORE::GLOBAL if it exists there.
+=head3 breakable_line(from, to) (API)
 
-=item 4. If it starts with '::', put it in 'main::'.
+The subroutine decides whether or not a line in the current file is breakable.
+It walks through C<@dbline> within the range of lines specified, looking for
+the first line that is breakable.
 
-=back
+If C<$to> is greater than C<$from>, the search moves forwards, finding the
+first line I<after> C<$to> that's breakable, if there is one.
 
-After all this cleanup, we call C<break_subroutine> to try to set the
-breakpoint.
+If C<$from> is greater than C<$to>, the search goes I<backwards>, finding the
+first line I<before> C<$to> that's breakable, if there is one.
 
 =cut
 
-sub cmd_b_sub {
-    my $subname = shift;
-    my $cond = @_ ? shift : 1;
-
-    # If the subname isn't a code reference, qualify it so that
-    # break_subroutine() will work right.
-    if ( ref($subname) ne 'CODE' ) {
+sub breakable_line {
 
-        # Not Perl 4.
-        $subname =~ s/'/::/g;
-        my $s = $subname;
+    my ( $from, $to ) = @_;
 
-        # Put it in this package unless it's already qualified.
-        if ($subname !~ /::/)
-        {
-            $subname = $package . '::' . $subname;
-        };
+    # $i is the start point. (Where are the FORTRAN programs of yesteryear?)
+    my $i = $from;
 
-        # Requalify it into CORE::GLOBAL if qualifying it into this
-        # package resulted in its not being defined, but only do so
-        # if it really is in CORE::GLOBAL.
-        my $core_name = "CORE::GLOBAL::$s";
-        if ((!defined(&$subname))
-                and ($s !~ /::/)
-                and (defined &{$core_name}))
-        {
-            $subname = $core_name;
-        }
+    # If there are at least 2 arguments, we're trying to search a range.
+    if ( @_ >= 2 ) {
 
-        # Put it in package 'main' if it has a leading ::.
-        if ($subname =~ /\A::/)
-        {
-            $subname = "main" . $subname;
-        }
-    } ## end if ( ref($subname) ne 'CODE' ) {
+        # $delta is positive for a forward search, negative for a backward one.
+        my $delta = $from < $to ? +1 : -1;
 
-    # Try to set the breakpoint.
-    if (not eval { break_subroutine( $subname, $cond ); 1 }) {
-        local $\ = '';
-        print {$OUT} $@;
-        return;
-    }
+        # Keep us from running off the ends of the file.
+        my $limit = $delta > 0 ? $#dbline : 1;
 
-    return;
-} ## end sub cmd_b_sub
+        # Clever test. If you're a mathematician, it's obvious why this
+        # test works. If not:
+        # If $delta is positive (going forward), $limit will be $#dbline.
+        #    If $to is less than $limit, ($limit - $to) will be positive, times
+        #    $delta of 1 (positive), so the result is > 0 and we should use $to
+        #    as the stopping point.
+        #
+        #    If $to is greater than $limit, ($limit - $to) is negative,
+        #    times $delta of 1 (positive), so the result is < 0 and we should
+        #    use $limit ($#dbline) as the stopping point.
+        #
+        # If $delta is negative (going backward), $limit will be 1.
+        #    If $to is zero, ($limit - $to) will be 1, times $delta of -1
+        #    (negative) so the result is > 0, and we use $to as the stopping
+        #    point.
+        #
+        #    If $to is less than zero, ($limit - $to) will be positive,
+        #    times $delta of -1 (negative), so the result is not > 0, and
+        #    we use $limit (1) as the stopping point.
+        #
+        #    If $to is 1, ($limit - $to) will zero, times $delta of -1
+        #    (negative), still giving zero; the result is not > 0, and
+        #    we use $limit (1) as the stopping point.
+        #
+        #    if $to is >1, ($limit - $to) will be negative, times $delta of -1
+        #    (negative), giving a positive (>0) value, so we'll set $limit to
+        #    $to.
 
-=head3 C<cmd_B> - delete breakpoint(s) (command)
+        $limit = $to if ( $limit - $to ) * $delta > 0;
 
-The command mostly parses the command line and tries to turn the argument
-into a line spec. If it can't, it uses the current line. It then calls
-C<delete_breakpoint> to actually do the work.
+        # The real search loop.
+        # $i starts at $from (the point we want to start searching from).
+        # We move through @dbline in the appropriate direction (determined
+        # by $delta: either -1 (back) or +1 (ahead).
+        # We stay in as long as we haven't hit an executable line
+        # ($dbline[$i] == 0 means not executable) and we haven't reached
+        # the limit yet (test similar to the above).
+        $i += $delta while $dbline[$i] == 0 and ( $limit - $i ) * $delta > 0;
 
-If C<*> is  specified, C<cmd_B> calls C<delete_breakpoint> with no arguments,
-thereby deleting all the breakpoints.
+    } ## end if (@_ >= 2)
 
-=cut
+    # If $i points to a line that is executable, return that.
+    return $i unless $dbline[$i] == 0;
 
-sub cmd_B {
-    my $cmd = shift;
+    # Format the message and print it: no breakable lines in range.
+    my ( $pl, $upto ) = ( '', '' );
+    ( $pl, $upto ) = ( 's', "..$to" ) if @_ >= 2 and $from != $to;
 
-    # No line spec? Use dbline.
-    # If there is one, use it if it's non-zero, or wipe it out if it is.
-    my $line   = ( $_[0] =~ /\A\./ ) ? $dbline : (shift || '');
-    my $dbline = shift;
+    # If there's a filename in filename_error, we'll see it.
+    # If not, not.
+    die "Line$pl $from$upto$filename_error not breakable\n";
+} ## end sub breakable_line
 
-    # If the line was dot, make the line the current one.
-    $line =~ s/^\./$dbline/;
+=head3 breakable_line_in_filename(file, from, to) (API)
 
-    # If it's * we're deleting all the breakpoints.
-    if ( $line eq '*' ) {
-        if (not eval { delete_breakpoint(); 1 }) {
-            print {$OUT} $@;
-        }
-    }
+Like C<breakable_line>, but look in another file.
 
-    # If there is a line spec, delete the breakpoint on that line.
-    elsif ( $line =~ /\A(\S.*)/ ) {
-        if (not eval { delete_breakpoint( $line || $dbline ); 1 }) {
-            local $\ = '';
-            print {$OUT} $@;
-        }
-    } ## end elsif ($line =~ /^(\S.*)/)
+=cut
 
-    # No line spec.
-    else {
-        print {$OUT}
-          "Deleting a breakpoint requires a line number, or '*' for all\n"
-          ;    # hint
-    }
+sub breakable_line_in_filename {
 
-    return;
-} ## end sub cmd_B
+    # Capture the file name.
+    my ($f) = shift;
 
-=head3 delete_breakpoint([line]) (API)
+    # Swap the magic line array over there temporarily.
+    local *dbline = $main::{ '_<' . $f };
 
-This actually does the work of deleting either a single breakpoint, or all
-of them.
+    # If there's an error, it's in this other file.
+    local $filename_error = " of '$f'";
 
-For a single line, we look for it in C<@dbline>. If it's nonbreakable, we
-just drop out with a message saying so. If it is, we remove the condition
-part of the 'condition\0action' that says there's a breakpoint here. If,
-after we've done that, there's nothing left, we delete the corresponding
-line in C<%dbline> to signal that no action needs to be taken for this line.
+    # Find the breakable line.
+    breakable_line(@_);
 
-For all breakpoints, we iterate through the keys of C<%had_breakpoints>,
-which lists all currently-loaded files which have breakpoints. We then look
-at each line in each of these files, temporarily switching the C<%dbline>
-and C<@dbline> structures to point to the files in question, and do what
-we did in the single line case: delete the condition in C<@dbline>, and
-delete the key in C<%dbline> if nothing's left.
+    # *dbline and $filename_error get restored when this block ends.
 
-We then wholesale delete C<%postponed>, C<%postponed_file>, and
-C<%break_on_load>, because these structures contain breakpoints for files
-and code that haven't been loaded yet. We can just kill these off because there
-are no magical debugger structures associated with them.
+} ## end sub breakable_line_in_filename
+
+=head3 break_on_line(lineno, [condition]) (API)
+
+Adds a breakpoint with the specified condition (or 1 if no condition was
+specified) to the specified line. Dies if it can't.
 
 =cut
 
-sub _remove_breakpoint_entry {
-    my ($fn, $i) = @_;
+sub break_on_line {
+    my $i = shift;
+    my $cond = @_ ? shift(@_) : 1;
 
-    delete $dbline{$i};
-    _delete_breakpoint_data_ref($fn, $i);
+    my $inii  = $i;
+    my $after = '';
+    my $pl    = '';
 
-    return;
-}
+    # Woops, not a breakable line. $filename_error allows us to say
+    # if it was in a different file.
+    die "Line $i$filename_error not breakable.\n" if $dbline[$i] == 0;
 
-sub _delete_all_breakpoints {
-    print {$OUT} "Deleting all breakpoints...\n";
+    # Mark this file as having breakpoints in it.
+    $had_breakpoints{$filename} |= 1;
 
-    # %had_breakpoints lists every file that had at least one
-    # breakpoint in it.
-    for my $fn ( keys %had_breakpoints ) {
+    # If there is an action or condition here already ...
+    if ( $dbline{$i} ) {
 
-        # Switch to the desired file temporarily.
-        local *dbline = $main::{ '_<' . $fn };
+        # ... swap this condition for the existing one.
+        $dbline{$i} =~ s/^[^\0]*/$cond/;
+    }
+    else {
 
-        $max = $#dbline;
+        # Nothing here - just add the condition.
+        $dbline{$i} = $cond;
 
-        # For all lines in this file ...
-        for my $i (1 .. $max) {
+        _set_breakpoint_enabled_status($filename, $i, 1);
+    }
 
-            # If there's a breakpoint or action on this line ...
-            if ( defined $dbline{$i} ) {
+    return;
+} ## end sub break_on_line
 
-                # ... remove the breakpoint.
-                $dbline{$i} =~ s/\A[^\0]+//;
-                if ( $dbline{$i} =~ s/\A\0?\z// ) {
-                    # Remove the entry altogether if no action is there.
-                    _remove_breakpoint_entry($fn, $i);
-                }
-            } ## end if (defined $dbline{$i...
-        } ## end for $i (1 .. $max)
+=head3 cmd_b_line(line, [condition]) (command)
 
-        # If, after we turn off the "there were breakpoints in this file"
-        # bit, the entry in %had_breakpoints for this file is zero,
-        # we should remove this file from the hash.
-        if ( not $had_breakpoints{$fn} &= (~1) ) {
-            delete $had_breakpoints{$fn};
-        }
-    } ## end for my $fn (keys %had_breakpoints)
+Wrapper for C<break_on_line>. Prints the failure message if it
+doesn't work.
 
-    # Kill off all the other breakpoints that are waiting for files that
-    # haven't been loaded yet.
-    undef %postponed;
-    undef %postponed_file;
-    undef %break_on_load;
+=cut
+
+sub cmd_b_line {
+    if (not eval { break_on_line(@_); 1 }) {
+        local $\ = '';
+        print $OUT $@ and return;
+    }
 
     return;
-}
+} ## end sub cmd_b_line
 
-sub _delete_breakpoint_from_line {
-    my ($i) = @_;
+=head3 cmd_b_filename_line(line, [condition]) (command)
 
-    # Woops. This line wasn't breakable at all.
-    die "Line $i not breakable.\n" if $dbline[$i] == 0;
+Wrapper for C<break_on_filename_line>. Prints the failure message if it
+doesn't work.
 
-    # Kill the condition, but leave any action.
-    $dbline{$i} =~ s/\A[^\0]*//;
+=cut
 
-    # Remove the entry entirely if there's no action left.
-    if ($dbline{$i} eq '') {
-        _remove_breakpoint_entry($filename, $i);
+sub cmd_b_filename_line {
+    if (not eval { break_on_filename_line(@_); 1 }) {
+        local $\ = '';
+        print $OUT $@ and return;
     }
 
     return;
 }
 
-sub delete_breakpoint {
+=head3 break_on_filename_line(file, line, [condition]) (API)
+
+Switches to the file specified and then calls C<break_on_line> to set
+the breakpoint.
+
+=cut
+
+sub break_on_filename_line {
+    my $f = shift;
     my $i = shift;
+    my $cond = @_ ? shift(@_) : 1;
 
-    # If we got a line, delete just that one.
-    if ( defined($i) ) {
-        _delete_breakpoint_from_line($i);
-    }
-    # No line; delete them all.
-    else {
-        _delete_all_breakpoints();
-    }
+    # Switch the magical hash temporarily.
+    local *dbline = $main::{ '_<' . $f };
+
+    # Localize the variables that break_on_line uses to make its message.
+    local $filename_error = " of '$f'";
+    local $filename       = $f;
+
+    # Add the breakpoint.
+    break_on_line( $i, $cond );
 
     return;
-}
+} ## end sub break_on_filename_line
 
-=head3 cmd_stop (command)
+=head3 break_on_filename_line_range(file, from, to, [condition]) (API)
 
-This is meant to be part of the new command API, but it isn't called or used
-anywhere else in the debugger. XXX It is probably meant for use in development
-of new commands.
+Switch to another file, search the range of lines specified for an
+executable one, and put a breakpoint on the first one you find.
 
 =cut
 
-sub cmd_stop {    # As on ^C, but not signal-safy.
-    $signal = 1;
-}
+sub break_on_filename_line_range {
+    my $f = shift;
+    my $from = shift;
+    my $to = shift;
+    my $cond = @_ ? shift(@_) : 1;
 
-=head3 C<cmd_e> - threads
+    # Find a breakable line if there is one.
+    my $i = breakable_line_in_filename( $f, $from, $to );
 
-Display the current thread id:
+    # Add the breakpoint.
+    break_on_filename_line( $f, $i, $cond );
 
-    e
+    return;
+} ## end sub break_on_filename_line_range
 
-This could be how (when implemented) to send commands to this thread id (e cmd)
-or that thread id (e tid cmd).
+=head3 subroutine_filename_lines(subname, [condition]) (API)
 
-=cut
+Search for a subroutine within a given file. The condition is ignored.
+Uses C<find_sub> to locate the desired subroutine.
 
-sub cmd_e {
-    my $cmd  = shift;
-    my $line = shift;
-    unless (exists($INC{'threads.pm'})) {
-        print "threads not loaded($ENV{PERL5DB_THREADED})
-        please run the debugger with PERL5DB_THREADED=1 set in the environment\n";
-    } else {
-        my $tid = threads->tid;
-        print "thread id: $tid\n";
-    }
-} ## end sub cmd_e
+=cut
 
-=head3 C<cmd_E> - list of thread ids
+sub subroutine_filename_lines {
+    my ( $subname ) = @_;
 
-Display the list of available thread ids:
+    # Returned value from find_sub() is fullpathname:startline-endline.
+    # The match creates the list (fullpathname, start, end).
+    return (find_sub($subname) =~ /^(.*):(\d+)-(\d+)$/);
+} ## end sub subroutine_filename_lines
 
-    E
+=head3 break_subroutine(subname) (API)
 
-This could be used (when implemented) to send commands to all threads (E cmd).
+Places a break on the first line possible in the specified subroutine. Uses
+C<subroutine_filename_lines> to find the subroutine, and
+C<break_on_filename_line_range> to place the break.
 
 =cut
 
-sub cmd_E {
-    my $cmd  = shift;
-    my $line = shift;
-    unless (exists($INC{'threads.pm'})) {
-        print "threads not loaded($ENV{PERL5DB_THREADED})
-        please run the debugger with PERL5DB_THREADED=1 set in the environment\n";
-    } else {
-        my $tid = threads->tid;
-        print "thread ids: ".join(', ',
-            map { ($tid == $_->tid ? '<'.$_->tid.'>' : $_->tid) } threads->list
-        )."\n";
-    }
-} ## end sub cmd_E
+sub break_subroutine {
+    my $subname = shift;
 
-=head3 C<cmd_h> - help command (command)
+    # Get filename, start, and end.
+    my ( $file, $s, $e ) = subroutine_filename_lines($subname)
+      or die "Subroutine $subname not found.\n";
 
-Does the work of either
 
-=over 4
+    # Null condition changes to '1' (always true).
+    my $cond = @_ ? shift(@_) : 1;
 
-=item *
+    # Put a break the first place possible in the range of lines
+    # that make up this subroutine.
+    break_on_filename_line_range( $file, $s, $e, $cond );
 
-Showing all the debugger help
+    return;
+} ## end sub break_subroutine
 
-=item *
+=head3 cmd_b_sub(subname, [condition]) (command)
+
+We take the incoming subroutine name and fully-qualify it as best we can.
+
+=over 4
+
+=item 1. If it's already fully-qualified, leave it alone.
 
-Showing help for a specific command
+=item 2. Try putting it in the current package.
 
-=back
+=item 3. If it's not there, try putting it in CORE::GLOBAL if it exists there.
 
-=cut
+=item 4. If it starts with '::', put it in 'main::'.
 
-use vars qw($help);
-use vars qw($summary);
+=back
 
-sub cmd_h {
-    my $cmd = shift;
+After all this cleanup, we call C<break_subroutine> to try to set the
+breakpoint.
 
-    # If we have no operand, assume null.
-    my $line = shift || '';
+=cut
 
-    # 'h h'. Print the long-format help.
-    if ( $line =~ /\Ah\s*\z/ ) {
-        print_help($help);
-    }
+sub cmd_b_sub {
+    my $subname = shift;
+    my $cond = @_ ? shift : 1;
 
-    # 'h <something>'. Search for the command and print only its help.
-    elsif ( my ($asked) = $line =~ /\A(\S.*)\z/ ) {
+    # If the subname isn't a code reference, qualify it so that
+    # break_subroutine() will work right.
+    if ( ref($subname) ne 'CODE' ) {
 
-        # support long commands; otherwise bogus errors
-        # happen when you ask for h on <CR> for example
-        my $qasked = quotemeta($asked);    # for searching; we don't
-                                           # want to use it as a pattern.
-                                           # XXX: finds CR but not <CR>
+        # Not Perl 4.
+        $subname =~ s/'/::/g;
+        my $s = $subname;
 
-        # Search the help string for the command.
-        if (
-            $help =~ /^                    # Start of a line
-                      <?                   # Optional '<'
-                      (?:[IB]<)            # Optional markup
-                      $qasked              # The requested command
-                     /mx
-          )
+        # Put it in this package unless it's already qualified.
+        if ($subname !~ /::/)
         {
+            $subname = $package . '::' . $subname;
+        };
 
-            # It's there; pull it out and print it.
-            while (
-                $help =~ /^
-                              (<?            # Optional '<'
-                                 (?:[IB]<)   # Optional markup
-                                 $qasked     # The command
-                                 ([\s\S]*?)  # Description line(s)
-                              \n)            # End of last description line
-                              (?!\s)         # Next line not starting with
-                                             # whitespace
-                             /mgx
-              )
-            {
-                print_help($1);
-            }
+        # Requalify it into CORE::GLOBAL if qualifying it into this
+        # package resulted in its not being defined, but only do so
+        # if it really is in CORE::GLOBAL.
+        my $core_name = "CORE::GLOBAL::$s";
+        if ((!defined(&$subname))
+                and ($s !~ /::/)
+                and (defined &{$core_name}))
+        {
+            $subname = $core_name;
         }
 
-        # Not found; not a debugger command.
-        else {
-            print_help("B<$asked> is not a debugger command.\n");
+        # Put it in package 'main' if it has a leading ::.
+        if ($subname =~ /\A::/)
+        {
+            $subname = "main" . $subname;
         }
-    } ## end elsif ($line =~ /^(\S.*)$/)
+    } ## end if ( ref($subname) ne 'CODE' ) {
 
-    # 'h' - print the summary help.
-    else {
-        print_help($summary);
+    # Try to set the breakpoint.
+    if (not eval { break_subroutine( $subname, $cond ); 1 }) {
+        local $\ = '';
+        print {$OUT} $@;
+        return;
     }
-} ## end sub cmd_h
 
-=head3 C<cmd_l> - list lines (command)
+    return;
+} ## end sub cmd_b_sub
 
-Most of the command is taken up with transforming all the different line
-specification syntaxes into 'start-stop'. After that is done, the command
-runs a loop over C<@dbline> for the specified range of lines. It handles
-the printing of each line and any markers (C<==E<gt>> for current line,
-C<b> for break on this line, C<a> for action on this line, C<:> for this
-line breakable).
+=head3 C<cmd_B> - delete breakpoint(s) (command)
 
-We save the last line listed in the C<$start> global for further listing
-later.
+The command mostly parses the command line and tries to turn the argument
+into a line spec. If it can't, it uses the current line. It then calls
+C<delete_breakpoint> to actually do the work.
+
+If C<*> is  specified, C<cmd_B> calls C<delete_breakpoint> with no arguments,
+thereby deleting all the breakpoints.
 
 =cut
 
-sub _min {
-    my $min = shift;
-    foreach my $v (@_) {
-        if ($min > $v) {
-            $min = $v;
+sub cmd_B {
+    my $cmd = shift;
+
+    # No line spec? Use dbline.
+    # If there is one, use it if it's non-zero, or wipe it out if it is.
+    my $line   = ( $_[0] =~ /\A\./ ) ? $dbline : (shift || '');
+    my $dbline = shift;
+
+    # If the line was dot, make the line the current one.
+    $line =~ s/^\./$dbline/;
+
+    # If it's * we're deleting all the breakpoints.
+    if ( $line eq '*' ) {
+        if (not eval { delete_breakpoint(); 1 }) {
+            print {$OUT} $@;
         }
     }
-    return $min;
-}
 
-sub _max {
-    my $max = shift;
-    foreach my $v (@_) {
-        if ($max < $v) {
-            $max = $v;
+    # If there is a line spec, delete the breakpoint on that line.
+    elsif ( $line =~ /\A(\S.*)/ ) {
+        if (not eval { delete_breakpoint( $line || $dbline ); 1 }) {
+            local $\ = '';
+            print {$OUT} $@;
         }
+    } ## end elsif ($line =~ /^(\S.*)/)
+
+    # No line spec.
+    else {
+        print {$OUT}
+          "Deleting a breakpoint requires a line number, or '*' for all\n"
+          ;    # hint
     }
-    return $max;
-}
 
-sub _minify_to_max {
-    my $ref = shift;
+    return;
+} ## end sub cmd_B
 
-    $$ref = _min($$ref, $max);
+=head3 delete_breakpoint([line]) (API)
 
-    return;
-}
+This actually does the work of deleting either a single breakpoint, or all
+of them.
 
-sub _cmd_l_handle_var_name {
-    my $var_name = shift;
+For a single line, we look for it in C<@dbline>. If it's nonbreakable, we
+just drop out with a message saying so. If it is, we remove the condition
+part of the 'condition\0action' that says there's a breakpoint here. If,
+after we've done that, there's nothing left, we delete the corresponding
+line in C<%dbline> to signal that no action needs to be taken for this line.
 
-    $evalarg = $var_name;
+For all breakpoints, we iterate through the keys of C<%had_breakpoints>,
+which lists all currently-loaded files which have breakpoints. We then look
+at each line in each of these files, temporarily switching the C<%dbline>
+and C<@dbline> structures to point to the files in question, and do what
+we did in the single line case: delete the condition in C<@dbline>, and
+delete the key in C<%dbline> if nothing's left.
 
-    my ($s) = DB::eval();
+We then wholesale delete C<%postponed>, C<%postponed_file>, and
+C<%break_on_load>, because these structures contain breakpoints for files
+and code that haven't been loaded yet. We can just kill these off because there
+are no magical debugger structures associated with them.
 
-    # Ooops. Bad scalar.
-    if ($@) {
-        print {$OUT} "Error: $@\n";
-        next CMD;
-    }
+=cut
 
-    # Good scalar. If it's a reference, find what it points to.
-    $s = CvGV_name($s);
-    print {$OUT} "Interpreted as: $1 $s\n";
-    $line = "$1 $s";
+sub _remove_breakpoint_entry {
+    my ($fn, $i) = @_;
 
-    # Call self recursively to really do the command.
-    return _cmd_l_main( $s );
+    delete $dbline{$i};
+    _delete_breakpoint_data_ref($fn, $i);
+
+    return;
 }
 
-sub _cmd_l_handle_subname {
+sub _delete_all_breakpoints {
+    print {$OUT} "Deleting all breakpoints...\n";
 
-    my $s = $subname;
+    # %had_breakpoints lists every file that had at least one
+    # breakpoint in it.
+    for my $fn ( keys %had_breakpoints ) {
 
-    # De-Perl4.
-    $subname =~ s/\'/::/;
+        # Switch to the desired file temporarily.
+        local *dbline = $main::{ '_<' . $fn };
 
-    # Put it in this package unless it starts with ::.
-    $subname = $package . "::" . $subname unless $subname =~ /::/;
+        $max = $#dbline;
 
-    # Put it in CORE::GLOBAL if t doesn't start with :: and
-    # it doesn't live in this package and it lives in CORE::GLOBAL.
-    $subname = "CORE::GLOBAL::$s"
-    if not defined &$subname
-        and $s !~ /::/
-        and defined &{"CORE::GLOBAL::$s"};
+        # For all lines in this file ...
+        for my $i (1 .. $max) {
 
-    # Put leading '::' names into 'main::'.
-    $subname = "main" . $subname if substr( $subname, 0, 2 ) eq "::";
+            # If there's a breakpoint or action on this line ...
+            if ( defined $dbline{$i} ) {
 
-    # Get name:start-stop from find_sub, and break this up at
-    # colons.
-    my @pieces = split( /:/, find_sub($subname) || $sub{$subname} );
+                # ... remove the breakpoint.
+                $dbline{$i} =~ s/\A[^\0]+//;
+                if ( $dbline{$i} =~ s/\A\0?\z// ) {
+                    # Remove the entry altogether if no action is there.
+                    _remove_breakpoint_entry($fn, $i);
+                }
+            } ## end if (defined $dbline{$i...
+        } ## end for $i (1 .. $max)
 
-    # Pull off start-stop.
-    my $subrange = pop @pieces;
+        # If, after we turn off the "there were breakpoints in this file"
+        # bit, the entry in %had_breakpoints for this file is zero,
+        # we should remove this file from the hash.
+        if ( not $had_breakpoints{$fn} &= (~1) ) {
+            delete $had_breakpoints{$fn};
+        }
+    } ## end for my $fn (keys %had_breakpoints)
 
-    # If the name contained colons, the split broke it up.
-    # Put it back together.
-    $file = join( ':', @pieces );
+    # Kill off all the other breakpoints that are waiting for files that
+    # haven't been loaded yet.
+    undef %postponed;
+    undef %postponed_file;
+    undef %break_on_load;
 
-    # If we're not in that file, switch over to it.
-    if ( $file ne $filename ) {
-        if (! $slave_editor) {
-            print {$OUT} "Switching to file '$file'.\n";
-        }
+    return;
+}
 
-        # Switch debugger's magic structures.
-        *dbline   = $main::{ '_<' . $file };
-        $max      = $#dbline;
-        $filename = $file;
-    } ## end if ($file ne $filename)
+sub _delete_breakpoint_from_line {
+    my ($i) = @_;
 
-    # Subrange is 'start-stop'. If this is less than a window full,
-    # swap it to 'start+', which will list a window from the start point.
-    if ($subrange) {
-        if ( eval($subrange) < -$window ) {
-            $subrange =~ s/-.*/+/;
-        }
+    # Woops. This line wasn't breakable at all.
+    die "Line $i not breakable.\n" if $dbline[$i] == 0;
 
-        # Call self recursively to list the range.
-        return _cmd_l_main( $subrange );
-    } ## end if ($subrange)
+    # Kill the condition, but leave any action.
+    $dbline{$i} =~ s/\A[^\0]*//;
 
-    # Couldn't find it.
-    else {
-        print {$OUT} "Subroutine $subname not found.\n";
-        return;
+    # Remove the entry entirely if there's no action left.
+    if ($dbline{$i} eq '') {
+        _remove_breakpoint_entry($filename, $i);
     }
+
+    return;
 }
 
-sub _cmd_l_empty {
-    # Compute new range to list.
-    $incr = $window - 1;
+sub delete_breakpoint {
+    my $i = shift;
 
-    # Recurse to do it.
-    return _cmd_l_main( $start . '-' . ( $start + $incr ) );
+    # If we got a line, delete just that one.
+    if ( defined($i) ) {
+        _delete_breakpoint_from_line($i);
+    }
+    # No line; delete them all.
+    else {
+        _delete_all_breakpoints();
+    }
+
+    return;
 }
 
-sub _cmd_l_plus {
-    my ($new_start, $new_incr) = @_;
+=head3 cmd_stop (command)
 
-    # Don't reset start for 'l +nnn'.
-    $start = $new_start if $new_start;
+This is meant to be part of the new command API, but it isn't called or used
+anywhere else in the debugger. XXX It is probably meant for use in development
+of new commands.
 
-    # Increment for list. Use window size if not specified.
-    # (Allows 'l +' to work.)
-    $incr = $new_incr || ($window - 1);
+=cut
 
-    # Create a line range we'll understand, and recurse to do it.
-    return _cmd_l_main( $start . '-' . ( $start + $incr ) );
+sub cmd_stop {    # As on ^C, but not signal-safy.
+    $signal = 1;
 }
 
-sub _cmd_l_calc_initial_end_and_i {
-    my ($spec, $start_match, $end_match) = @_;
+=head3 C<cmd_e> - threads
 
-    # Determine end point; use end of file if not specified.
-    my $end = ( !defined $start_match ) ? $max :
-    ( $end_match ? $end_match : $start_match );
+Display the current thread id:
 
-    # Go on to the end, and then stop.
-    _minify_to_max(\$end);
+    e
 
-    # Determine start line.
-    my $i = $start_match;
+This could be how (when implemented) to send commands to this thread id (e cmd)
+or that thread id (e tid cmd).
 
-    if ($i eq '.') {
-        $i = $spec;
+=cut
+
+sub cmd_e {
+    my $cmd  = shift;
+    my $line = shift;
+    unless (exists($INC{'threads.pm'})) {
+        print "threads not loaded($ENV{PERL5DB_THREADED})
+        please run the debugger with PERL5DB_THREADED=1 set in the environment\n";
+    } else {
+        my $tid = threads->tid;
+        print "thread id: $tid\n";
     }
+} ## end sub cmd_e
 
-    $i = _max($i, 1);
+=head3 C<cmd_E> - list of thread ids
 
-    $incr = $end - $i;
+Display the list of available thread ids:
 
-    return ($end, $i);
-}
+    E
 
-sub _cmd_l_range {
-    my ($spec, $current_line, $start_match, $end_match) = @_;
+This could be used (when implemented) to send commands to all threads (E cmd).
 
-    my ($end, $i) =
-        _cmd_l_calc_initial_end_and_i($spec, $start_match, $end_match);
+=cut
 
-    # If we're running under a slave editor, force it to show the lines.
-    if ($slave_editor) {
-        print {$OUT} "\032\032$filename:$i:0\n";
-        $i = $end;
+sub cmd_E {
+    my $cmd  = shift;
+    my $line = shift;
+    unless (exists($INC{'threads.pm'})) {
+        print "threads not loaded($ENV{PERL5DB_THREADED})
+        please run the debugger with PERL5DB_THREADED=1 set in the environment\n";
+    } else {
+        my $tid = threads->tid;
+        print "thread ids: ".join(', ',
+            map { ($tid == $_->tid ? '<'.$_->tid.'>' : $_->tid) } threads->list
+        )."\n";
     }
-    # We're doing it ourselves. We want to show the line and special
-    # markers for:
-    # - the current line in execution
-    # - whether a line is breakable or not
-    # - whether a line has a break or not
-    # - whether a line has an action or not
-    else {
-        I_TO_END:
-        for ( ; $i <= $end ; $i++ ) {
+} ## end sub cmd_E
 
-            # Check for breakpoints and actions.
-            my ( $stop, $action );
-            if ($dbline{$i}) {
-                ( $stop, $action ) = split( /\0/, $dbline{$i} );
-            }
+=head3 C<cmd_h> - help command (command)
 
-            # ==> if this is the current line in execution,
-            # : if it's breakable.
-            my $arrow =
-            ( $i == $current_line and $filename eq $filename_ini )
-            ? '==>'
-            : ( $dbline[$i] + 0 ? ':' : ' ' );
+Does the work of either
 
-            # Add break and action indicators.
-            $arrow .= 'b' if $stop;
-            $arrow .= 'a' if $action;
+=over 4
 
-            # Print the line.
-            print {$OUT} "$i$arrow\t", $dbline[$i];
+=item *
 
-            # Move on to the next line. Drop out on an interrupt.
-            if ($signal) {
-                $i++;
-                last I_TO_END;
-            }
-        } ## end for (; $i <= $end ; $i++)
+Showing all the debugger help
 
-        # Line the prompt up; print a newline if the last line listed
-        # didn't have a newline.
-        if ($dbline[ $i - 1 ] !~ /\n\z/) {
-            print {$OUT} "\n";
-        }
-    } ## end else [ if ($slave_editor)
+=item *
 
-    # Save the point we last listed to in case another relative 'l'
-    # command is desired. Don't let it run off the end.
-    $start = $i;
-    _minify_to_max(\$start);
+Showing help for a specific command
 
-    return;
-}
+=back
 
-sub _cmd_l_main {
-    my $spec = shift;
+=cut
 
-    # If this is '-something', delete any spaces after the dash.
-    $spec =~ s/\A-\s*\z/-/;
+use vars qw($help);
+use vars qw($summary);
 
-    # If the line is '$something', assume this is a scalar containing a
-    # line number.
-    # Set up for DB::eval() - evaluate in *user* context.
-    if ( my ($var_name) = $spec =~ /\A(\$.*)/s ) {
-        return _cmd_l_handle_var_name($var_name);
-    }
-    # l name. Try to find a sub by that name.
-    elsif ( ($subname) = $spec =~ /\A([\':A-Za-z_][\':\w]*(?:\[.*\])?)/s ) {
-        return _cmd_l_handle_subname();
-    }
-    # Bare 'l' command.
-    elsif ( $spec !~ /\S/ ) {
-        return _cmd_l_empty();
-    }
-    # l [start]+number_of_lines
-    elsif ( my ($new_start, $new_incr) = $spec =~ /\A(\d*)\+(\d*)\z/ ) {
-        return _cmd_l_plus($new_start, $new_incr);
-    }
-    # l start-stop or l start,stop
-    elsif (my ($s, $e) = $spec =~ /^(?:(-?[\d\$\.]+)(?:[-,]([\d\$\.]+))?)?/ ) {
-        return _cmd_l_range($spec, $line, $s, $e);
+sub cmd_h {
+    my $cmd = shift;
+
+    # If we have no operand, assume null.
+    my $line = shift || '';
+
+    # 'h h'. Print the long-format help.
+    if ( $line =~ /\Ah\s*\z/ ) {
+        print_help($help);
     }
 
-    return;
-} ## end sub cmd_l
+    # 'h <something>'. Search for the command and print only its help.
+    elsif ( my ($asked) = $line =~ /\A(\S.*)\z/ ) {
 
-sub cmd_l {
-    my (undef, $line) = @_;
+        # support long commands; otherwise bogus errors
+        # happen when you ask for h on <CR> for example
+        my $qasked = quotemeta($asked);    # for searching; we don't
+                                           # want to use it as a pattern.
+                                           # XXX: finds CR but not <CR>
 
-    return _cmd_l_main($line);
-}
+        # Search the help string for the command.
+        if (
+            $help =~ /^                    # Start of a line
+                      <?                   # Optional '<'
+                      (?:[IB]<)            # Optional markup
+                      $qasked              # The requested command
+                     /mx
+          )
+        {
+
+            # It's there; pull it out and print it.
+            while (
+                $help =~ /^
+                              (<?            # Optional '<'
+                                 (?:[IB]<)   # Optional markup
+                                 $qasked     # The command
+                                 ([\s\S]*?)  # Description line(s)
+                              \n)            # End of last description line
+                              (?!\s)         # Next line not starting with
+                                             # whitespace
+                             /mgx
+              )
+            {
+                print_help($1);
+            }
+        }
+
+        # Not found; not a debugger command.
+        else {
+            print_help("B<$asked> is not a debugger command.\n");
+        }
+    } ## end elsif ($line =~ /^(\S.*)$/)
+
+    # 'h' - print the summary help.
+    else {
+        print_help($summary);
+    }
+} ## end sub cmd_h
 
 =head3 C<cmd_L> - list breakpoints, actions, and watch expressions (command)
 
index ffa659a..d68eeb7 100644 (file)
@@ -2966,6 +2966,31 @@ SKIP:
        );
 }
 
+{
+    # gh #17661 related - C<l $var> where $var is lexical
+    my $wrapper = DebugWrap->new(
+        {
+            cmds =>
+            [
+                'c',
+                'l $x',
+                'l $y',
+                'q',
+            ],
+            prog => '../lib/perl5db/t/gh-17661b',
+        }
+    );
+
+    $wrapper->contents_like(
+        qr/sub bar/,
+        q/check bar was listed/,
+       );
+    $wrapper->contents_like(
+        qr/sub foo/,
+        q/check foo was listed/,
+       );
+}
+
 SKIP:
 {
     $Config{usethreads}
diff --git a/lib/perl5db/t/gh-17661b b/lib/perl5db/t/gh-17661b
new file mode 100644 (file)
index 0000000..25bafdb
--- /dev/null
@@ -0,0 +1,14 @@
+#!perl
+# test code for "l $var" where $var is lexical
+sub foo {
+    print "Hello\n";
+}
+
+sub bar {
+    print "Goodbye\n";
+}
+
+my $x = \&foo;
+our $y = \&bar;
+$DB::single = 1;
+my $z = 1;