0.pre7.122:

[sbcl.git] / src / code / debug.lisp

diff --git a/src/code/debug.lisp b/src/code/debug.lisp
index 5105bb4..535b429 100644 (file)
--- a/src/code/debug.lisp
+++ b/src/code/debug.lisp
@@ -10,9 +10,6 @@
 ;;;; files for more information.
 
 (in-package "SB!DEBUG")
 ;;;; files for more information.
 
 (in-package "SB!DEBUG")

-
-(file-comment
-  "$Header$")

 \f
 ;;;; variables and constants
 
 \f
 ;;;; variables and constants
 

@@ -25,10 +22,10 @@
   "*PRINT-LENGTH* for the debugger")
 
 (defvar *debug-readtable*
   "*PRINT-LENGTH* for the debugger")
 
 (defvar *debug-readtable*

-  ;; KLUDGE: This can't be initialized in a cold toplevel form, because the
-  ;; *STANDARD-READTABLE* isn't initialized until after cold toplevel forms
-  ;; have run. So instead we initialize it immediately after
-  ;; *STANDARD-READTABLE*. -- WHN 20000205
+  ;; KLUDGE: This can't be initialized in a cold toplevel form,
+  ;; because the *STANDARD-READTABLE* isn't initialized until after
+  ;; cold toplevel forms have run. So instead we initialize it
+  ;; immediately after *STANDARD-READTABLE*. -- WHN 20000205

   nil
   #!+sb-doc
   "*READTABLE* for the debugger")
   nil
   #!+sb-doc
   "*READTABLE* for the debugger")

@@ -37,57 +34,53 @@
   #!+sb-doc
   "This is T while in the debugger.")
 
   #!+sb-doc
   "This is T while in the debugger.")
 

-(defvar *debug-command-level* 0
-  #!+sb-doc
-  "Pushes and pops/exits inside the debugger change this.")
+;;; nestedness inside debugger command loops
+(defvar *debug-command-level* 0)
+
+;;; If this is bound before the debugger is invoked, it is used as the
+;;; stack top by the debugger.
+(defvar *stack-top-hint* nil)

 
 

-(defvar *stack-top-hint* nil
-  #!+sb-doc
-  "If this is bound before the debugger is invoked, it is used as the stack
-   top by the debugger.")

 (defvar *stack-top* nil)
 (defvar *real-stack-top* nil)
 
 (defvar *current-frame* nil)
 
 (defvar *stack-top* nil)
 (defvar *real-stack-top* nil)
 
 (defvar *current-frame* nil)
 

-;;; the default for *DEBUG-PROMPT*
-(defun debug-prompt ()
-  (let ((*standard-output* *debug-io*))
-    (terpri)
-    (prin1 (sb!di:frame-number *current-frame*))
-    (dotimes (i *debug-command-level*) (princ "]"))
-    (princ " ")
-    (force-output)))
-
-(defparameter *debug-prompt* #'debug-prompt
-  #!+sb-doc
-  "a function of no arguments that prints the debugger prompt on *DEBUG-IO*")
-
+;;; Beginner-oriented help messages are important because you end up
+;;; in the debugger whenever something bad happens, or if you try to
+;;; get out of the system with Ctrl-C or (EXIT) or EXIT or whatever.
+;;; But after memorizing them the wasted screen space gets annoying..
+(defvar *debug-beginner-help-p* t
+  "Should the debugger display beginner-oriented help messages?")
+
+(defun debug-prompt (stream)
+  (format stream
+         "~%~W~:[~;[~W~]] "
+         (sb!di:frame-number *current-frame*)
+         (> *debug-command-level* 1)
+         *debug-command-level*))
+  

 (defparameter *debug-help-string*
 "The prompt is right square brackets, the number indicating how many
   recursive command loops you are in. 
 Any command may be uniquely abbreviated.
 (defparameter *debug-help-string*
 "The prompt is right square brackets, the number indicating how many
   recursive command loops you are in. 
 Any command may be uniquely abbreviated.

-The debugger rebinds various special variables for controlling i/o,
-  sometimes to defaults (a la WITH-STANDARD-IO-SYNTAX) and sometimes to 
-  its own values, e.g. SB-DEBUG:*DEBUG-PRINT-LEVEL*.
+The debugger rebinds various special variables for controlling i/o, sometimes
+  to defaults (much like WITH-STANDARD-IO-SYNTAX does) and sometimes to 
+  its own special values, e.g. SB-DEBUG:*DEBUG-PRINT-LEVEL*.

 Debug commands do not affect * and friends, but evaluation in the debug loop
 Debug commands do not affect * and friends, but evaluation in the debug loop

-  do affect these variables.
+  does affect these variables.

 SB-DEBUG:*FLUSH-DEBUG-ERRORS* controls whether errors at the debug prompt
   drop you into deeper into the debugger.
 
 Getting in and out of the debugger:
 SB-DEBUG:*FLUSH-DEBUG-ERRORS* controls whether errors at the debug prompt
   drop you into deeper into the debugger.
 
 Getting in and out of the debugger:

-  Q        throws to top level.
-  GO       calls CONTINUE which tries to proceed with the restart 'CONTINUE.

   RESTART  invokes restart numbered as shown (prompt if not given).
   ERROR    prints the error condition and restart cases.
   RESTART  invokes restart numbered as shown (prompt if not given).
   ERROR    prints the error condition and restart cases.

-

   The name of any restart, or its number, is a valid command, and is the same
     as using RESTART to invoke that restart.
 
 Changing frames:
   The name of any restart, or its number, is a valid command, and is the same
     as using RESTART to invoke that restart.
 
 Changing frames:

-  U     up frame     D  down frame
-  T     top frame    B  bottom frame
-  F n   frame n
+  U      up frame     D    down frame
+  B  bottom frame     F n  frame n (n=0 for top frame)

 
 Inspecting frames:
   BACKTRACE [n]  shows n frames going down the stack.
 
 Inspecting frames:
   BACKTRACE [n]  shows n frames going down the stack.

@@ -96,8 +89,8 @@ Inspecting frames:
   SOURCE [n]     displays frame's source form with n levels of enclosing forms.
 
 Breakpoints and steps:
   SOURCE [n]     displays frame's source form with n levels of enclosing forms.
 
 Breakpoints and steps:

-  LIST-LOCATIONS [{function | :c}]   List the locations for breakpoints.
-                                     Specify :c for the current frame.
+  LIST-LOCATIONS [{function | :C}]   List the locations for breakpoints.
+                                     Specify :C for the current frame.

     Abbreviation: LL
   LIST-BREAKPOINTS                   List the active breakpoints.
     Abbreviations: LB, LBP
     Abbreviation: LL
   LIST-BREAKPOINTS                   List the active breakpoints.
     Abbreviations: LB, LBP

@@ -131,8 +124,8 @@ Function and macro commands:
   #!+sb-doc
   "When true, list the code location type in the LIST-LOCATIONS command.")
 
   #!+sb-doc
   "When true, list the code location type in the LIST-LOCATIONS command.")
 

-;;; a list of the types of code-locations that should not be stepped to and
-;;; should not be listed when listing breakpoints
+;;; a list of the types of code-locations that should not be stepped
+;;; to and should not be listed when listing breakpoints

 (defvar *bad-code-location-types* '(:call-site :internal-error))
 (declaim (type list *bad-code-location-types*))
 
 (defvar *bad-code-location-types* '(:call-site :internal-error))
 (declaim (type list *bad-code-location-types*))
 

@@ -140,12 +133,12 @@ Function and macro commands:
 (defvar *possible-breakpoints*)
 (declaim (type list *possible-breakpoints*))
 
 (defvar *possible-breakpoints*)
 (declaim (type list *possible-breakpoints*))
 

-;;; a list of the made and active breakpoints, each is a breakpoint-info
-;;; structure
+;;; a list of the made and active breakpoints, each is a
+;;; BREAKPOINT-INFO structure

 (defvar *breakpoints* nil)
 (declaim (type list *breakpoints*))
 
 (defvar *breakpoints* nil)
 (declaim (type list *breakpoints*))
 

-;;; a list of breakpoint-info structures of the made and active step
+;;; a list of BREAKPOINT-INFO structures of the made and active step

 ;;; breakpoints
 (defvar *step-breakpoints* nil)
 (declaim (type list *step-breakpoints*))
 ;;; breakpoints
 (defvar *step-breakpoints* nil)
 (declaim (type list *step-breakpoints*))

@@ -155,8 +148,8 @@ Function and macro commands:
 (declaim (type integer *number-of-steps*))
 
 ;;; This is used when listing and setting breakpoints.
 (declaim (type integer *number-of-steps*))
 
 ;;; This is used when listing and setting breakpoints.

-(defvar *default-breakpoint-debug-function* nil)
-(declaim (type (or list sb!di:debug-function) *default-breakpoint-debug-function*))
+(defvar *default-breakpoint-debug-fun* nil)
+(declaim (type (or list sb!di:debug-fun) *default-breakpoint-debug-fun*))

 \f
 ;;;; code location utilities
 
 \f
 ;;;; code location utilities
 

@@ -170,8 +163,8 @@ Function and macro commands:
        (setf found t)))
     first-code-location))
 
        (setf found t)))
     first-code-location))
 

-;;; Return a list of the next code-locations following the one passed. One of
-;;; the *BAD-CODE-LOCATION-TYPES* will not be returned.
+;;; Return a list of the next code-locations following the one passed.
+;;; One of the *BAD-CODE-LOCATION-TYPES* will not be returned.

 (defun next-code-locations (code-location)
   (let ((debug-block (sb!di:code-location-debug-block code-location))
        (block-code-locations nil))
 (defun next-code-locations (code-location)
   (let ((debug-block (sb!di:code-location-debug-block code-location))
        (block-code-locations nil))

@@ -192,11 +185,10 @@ Function and macro commands:
        (setf next-list (next-code-locations (first next-list))))
       next-list)))
 
        (setf next-list (next-code-locations (first next-list))))
       next-list)))
 

-;;; Returns a list of code-locations of the possible breakpoints of the
-;;; debug-function passed.
-(defun possible-breakpoints (debug-function)
+;;; Return a list of code-locations of the possible breakpoints of DEBUG-FUN.
+(defun possible-breakpoints (debug-fun)

   (let ((possible-breakpoints nil))
   (let ((possible-breakpoints nil))

-    (sb!di:do-debug-function-blocks (debug-block debug-function)
+    (sb!di:do-debug-fun-blocks (debug-block debug-fun)

       (unless (sb!di:debug-block-elsewhere-p debug-block)
        (if *only-block-start-locations*
            (push (first-code-location debug-block) possible-breakpoints)
       (unless (sb!di:debug-block-elsewhere-p debug-block)
        (if *only-block-start-locations*
            (push (first-code-location debug-block) possible-breakpoints)

@@ -206,11 +198,11 @@ Function and macro commands:
                (push code-location possible-breakpoints))))))
     (nreverse possible-breakpoints)))
 
                (push code-location possible-breakpoints))))))
     (nreverse possible-breakpoints)))
 

-;;; Searches the info-list for the item passed (code-location, debug-function,
-;;; or breakpoint-info). If the item passed is a debug function then kind will
-;;; be compared if it was specified. The kind if also compared if a
-;;; breakpoint-info is passed since it's in the breakpoint. The info structure
-;;; is returned if found.
+;;; Search the info-list for the item passed (CODE-LOCATION,
+;;; DEBUG-FUN, or BREAKPOINT-INFO). If the item passed is a debug
+;;; function then kind will be compared if it was specified. The kind
+;;; if also compared if a breakpoint-info is passed since it's in the
+;;; breakpoint. The info structure is returned if found.

 (defun location-in-list (place info-list &optional (kind nil))
   (when (breakpoint-info-p place)
     (setf kind (sb!di:breakpoint-kind (breakpoint-info-breakpoint place)))
 (defun location-in-list (place info-list &optional (kind nil))
   (when (breakpoint-info-p place)
     (setf kind (sb!di:breakpoint-kind (breakpoint-info-breakpoint place)))

@@ -218,22 +210,23 @@ Function and macro commands:
   (cond ((sb!di:code-location-p place)
         (find place info-list
               :key #'breakpoint-info-place
   (cond ((sb!di:code-location-p place)
         (find place info-list
               :key #'breakpoint-info-place

-              :test #'(lambda (x y) (and (sb!di:code-location-p y)
-                                         (sb!di:code-location= x y)))))
+              :test (lambda (x y) (and (sb!di:code-location-p y)
+                                       (sb!di:code-location= x y)))))

        (t
         (find place info-list
        (t
         (find place info-list

-              :test #'(lambda (x-debug-function y-info)
-                        (let ((y-place (breakpoint-info-place y-info))
-                              (y-breakpoint (breakpoint-info-breakpoint
-                                             y-info)))
-                          (and (sb!di:debug-function-p y-place)
-                               (eq x-debug-function y-place)
-                               (or (not kind)
-                                   (eq kind (sb!di:breakpoint-kind
-                                             y-breakpoint))))))))))
-
-;;; If Loc is an unknown location, then try to find the block start location.
-;;; Used by source printing to some information instead of none for the user.
+              :test (lambda (x-debug-fun y-info)
+                      (let ((y-place (breakpoint-info-place y-info))
+                            (y-breakpoint (breakpoint-info-breakpoint
+                                           y-info)))
+                        (and (sb!di:debug-fun-p y-place)
+                             (eq x-debug-fun y-place)
+                             (or (not kind)
+                                 (eq kind (sb!di:breakpoint-kind
+                                           y-breakpoint))))))))))
+
+;;; If LOC is an unknown location, then try to find the block start
+;;; location. Used by source printing to some information instead of
+;;; none for the user.

 (defun maybe-block-start-location (loc)
   (if (sb!di:code-location-unknown-p loc)
       (let* ((block (sb!di:code-location-debug-block loc))
 (defun maybe-block-start-location (loc)
   (if (sb!di:code-location-unknown-p loc)
       (let* ((block (sb!di:code-location-debug-block loc))

@@ -251,28 +244,27 @@ Function and macro commands:
 ;;;; the BREAKPOINT-INFO structure
 
 ;;; info about a made breakpoint
 ;;;; the BREAKPOINT-INFO structure
 
 ;;; info about a made breakpoint

-(defstruct breakpoint-info
+(defstruct (breakpoint-info (:copier nil))

   ;; where we are going to stop
   ;; where we are going to stop

-  (place (required-argument)
-        :type (or sb!di:code-location sb!di:debug-function))
+  (place (missing-arg)  :type (or sb!di:code-location sb!di:debug-fun))

   ;; the breakpoint returned by sb!di:make-breakpoint
   ;; the breakpoint returned by sb!di:make-breakpoint

-  (breakpoint (required-argument) :type sb!di:breakpoint)
-  ;; the function returned from sb!di:preprocess-for-eval. If result is
+  (breakpoint (missing-arg) :type sb!di:breakpoint)
+  ;; the function returned from SB!DI:PREPROCESS-FOR-EVAL. If result is

   ;; non-NIL, drop into the debugger.
   (break #'identity :type function)
   ;; the function returned from sb!di:preprocess-for-eval. If result is
   ;; non-NIL, eval (each) print and print results.
   (condition #'identity :type function)
   ;; non-NIL, drop into the debugger.
   (break #'identity :type function)
   ;; the function returned from sb!di:preprocess-for-eval. If result is
   ;; non-NIL, eval (each) print and print results.
   (condition #'identity :type function)

-  ;; the list of functions from sb!di:preprocess-for-eval to evaluate. Results
-  ;; are conditionally printed. Car of each element is the function, cdr is the
-  ;; form it goes with.
+  ;; the list of functions from sb!di:preprocess-for-eval to evaluate.
+  ;; Results are conditionally printed. Car of each element is the
+  ;; function, cdr is the form it goes with.

   (print nil :type list)
   (print nil :type list)

-  ;; the number used when listing the possible breakpoints within a function.
-  ;; Could also be a symbol such as start or end.
-  (code-location-number (required-argument) :type (or symbol integer))
+  ;; the number used when listing the possible breakpoints within a
+  ;; function. Could also be a symbol such as start or end.
+  (code-location-number (missing-arg) :type (or symbol integer))

   ;; the number used when listing the breakpoints active and to delete
   ;; breakpoints
   ;; the number used when listing the breakpoints active and to delete
   ;; breakpoints

-  (breakpoint-number (required-argument) :type integer))
+  (breakpoint-number (missing-arg) :type integer))

 
 ;;; Return a new BREAKPOINT-INFO structure with the info passed.
 (defun create-breakpoint-info (place breakpoint code-location-number
 
 ;;; Return a new BREAKPOINT-INFO structure with the info passed.
 (defun create-breakpoint-info (place breakpoint code-location-number

@@ -304,23 +296,23 @@ Function and macro commands:
               "~&~S: ~S in ~S"
               bp-number
               loc-number
               "~&~S: ~S in ~S"
               bp-number
               loc-number

-              (sb!di:debug-function-name (sb!di:code-location-debug-function
-                                          place))))
-      (:function-start
-       (format t "~&~S: FUNCTION-START in ~S" bp-number
-              (sb!di:debug-function-name place)))
-      (:function-end
-       (format t "~&~S: FUNCTION-END in ~S" bp-number
-              (sb!di:debug-function-name place))))))
+              (sb!di:debug-fun-name (sb!di:code-location-debug-fun
+                                     place))))
+      (:fun-start
+       (format t "~&~S: FUN-START in ~S" bp-number
+              (sb!di:debug-fun-name place)))
+      (:fun-end
+       (format t "~&~S: FUN-END in ~S" bp-number
+              (sb!di:debug-fun-name place))))))

 \f
 ;;;; MAIN-HOOK-FUNCTION for steps and breakpoints
 
 \f
 ;;;; MAIN-HOOK-FUNCTION for steps and breakpoints
 

-;;; This must be passed as the hook function. It keeps track of where step
-;;; breakpoints are.
+;;; This must be passed as the hook function. It keeps track of where
+;;; STEP breakpoints are.

 (defun main-hook-function (current-frame breakpoint &optional return-vals
 (defun main-hook-function (current-frame breakpoint &optional return-vals

-                                        function-end-cookie)
-  (setf *default-breakpoint-debug-function*
-       (sb!di:frame-debug-function current-frame))
+                                        fun-end-cookie)
+  (setf *default-breakpoint-debug-fun*
+       (sb!di:frame-debug-fun current-frame))

   (dolist (step-info *step-breakpoints*)
     (sb!di:delete-breakpoint (breakpoint-info-breakpoint step-info))
     (let ((bp-info (location-in-list step-info *breakpoints*)))
   (dolist (step-info *step-breakpoints*)
     (sb!di:delete-breakpoint (breakpoint-info-breakpoint step-info))
     (let ((bp-info (location-in-list step-info *breakpoints*)))

@@ -344,7 +336,7 @@ Function and macro commands:
             (print-common-info ()
               (build-string
                (with-output-to-string (*standard-output*)
             (print-common-info ()
               (build-string
                (with-output-to-string (*standard-output*)

-                 (when function-end-cookie
+                 (when fun-end-cookie

                    (format t "~%Return values: ~S" return-vals))
                  (when condition
                    (when (breakpoint-info-print bp-hit-info)
                    (format t "~%Return values: ~S" return-vals))
                  (when condition
                    (when (breakpoint-info-print bp-hit-info)

@@ -413,11 +405,11 @@ Function and macro commands:
            (push (create-breakpoint-info code-location bp 0)
                  *step-breakpoints*))))
        (t
            (push (create-breakpoint-info code-location bp 0)
                  *step-breakpoints*))))
        (t

-       (let* ((debug-function (sb!di:frame-debug-function *current-frame*))
-              (bp (sb!di:make-breakpoint #'main-hook-function debug-function
-                                         :kind :function-end)))
+       (let* ((debug-fun (sb!di:frame-debug-fun *current-frame*))
+              (bp (sb!di:make-breakpoint #'main-hook-function debug-fun
+                                         :kind :fun-end)))

          (sb!di:activate-breakpoint bp)
          (sb!di:activate-breakpoint bp)

-         (push (create-breakpoint-info debug-function bp 0)
+         (push (create-breakpoint-info debug-fun bp 0)

                *step-breakpoints*))))))))
 \f
 ;;;; STEP
                *step-breakpoints*))))))))
 \f
 ;;;; STEP

@@ -436,7 +428,7 @@ Function and macro commands:
                            (*standard-output* *debug-io*))
   #!+sb-doc
   "Show a listing of the call stack going down from the current frame. In the
                            (*standard-output* *debug-io*))
   #!+sb-doc
   "Show a listing of the call stack going down from the current frame. In the

-   debugger, the current frame is indicated by the prompt. Count is how many
+   debugger, the current frame is indicated by the prompt. COUNT is how many

    frames to show."
   (fresh-line *standard-output*)
   (do ((frame (if *in-the-debugger* *current-frame* (sb!di:top-frame))
    frames to show."
   (fresh-line *standard-output*)
   (do ((frame (if *in-the-debugger* *current-frame* (sb!di:top-frame))

@@ -451,8 +443,8 @@ Function and macro commands:
 
 (eval-when (:compile-toplevel :execute)
 
 
 (eval-when (:compile-toplevel :execute)
 

-;;; This is a convenient way to express what to do for each type of lambda-list
-;;; element.
+;;; This is a convenient way to express what to do for each type of
+;;; lambda-list element.

 (sb!xc:defmacro lambda-list-element-dispatch (element
                                              &key
                                              required
 (sb!xc:defmacro lambda-list-element-dispatch (element
                                              &key
                                              required

@@ -469,7 +461,7 @@ Function and macro commands:
        (:rest ,@rest)
        (:keyword ,@keyword)))
      (symbol
        (:rest ,@rest)
        (:keyword ,@keyword)))
      (symbol

-      (assert (eq ,element :deleted))
+      (aver (eq ,element :deleted))

       ,@deleted)))
 
 (sb!xc:defmacro lambda-var-dispatch (variable location deleted valid other)
       ,@deleted)))
 
 (sb!xc:defmacro lambda-var-dispatch (variable location deleted valid other)

@@ -490,19 +482,20 @@ Function and macro commands:
            (:print-object (lambda (x s)
                             (print-unreadable-object (x s :type t)
                               (write-string (unprintable-object-string x)
            (:print-object (lambda (x s)
                             (print-unreadable-object (x s :type t)
                               (write-string (unprintable-object-string x)

-                                            s)))))
+                                            s))))
+           (:copier nil))

   string)
 
   string)
 

-;;; Print frame with verbosity level 1. If we hit a rest-arg, then
+;;; Print FRAME with verbosity level 1. If we hit a &REST arg, then

 ;;; print as many of the values as possible, punting the loop over
 ;;; lambda-list variables since any other arguments will be in the
 ;;; print as many of the values as possible, punting the loop over
 ;;; lambda-list variables since any other arguments will be in the

-;;; rest-arg's list of values.
+;;; &REST arg's list of values.

 (defun print-frame-call-1 (frame)
 (defun print-frame-call-1 (frame)

-  (let* ((d-fun (sb!di:frame-debug-function frame))
+  (let* ((d-fun (sb!di:frame-debug-fun frame))

         (loc (sb!di:frame-code-location frame))
         (loc (sb!di:frame-code-location frame))

-        (results (list (sb!di:debug-function-name d-fun))))
+        (results (list (sb!di:debug-fun-name d-fun))))

     (handler-case
     (handler-case

-       (dolist (ele (sb!di:debug-function-lambda-list d-fun))
+       (dolist (ele (sb!di:debug-fun-lambda-list d-fun))

          (lambda-list-element-dispatch ele
            :required ((push (frame-call-arg ele loc frame) results))
            :optional ((push (frame-call-arg (second ele) loc frame) results))
          (lambda-list-element-dispatch ele
            :required ((push (frame-call-arg ele loc frame) results))
            :optional ((push (frame-call-arg (second ele) loc frame) results))

@@ -517,15 +510,18 @@ Function and macro commands:
                                               (second ele) frame))
                                     results))
                       (return))
                                               (second ele) frame))
                                     results))
                       (return))

-                    (push (make-unprintable-object "unavailable &REST arg")
+                    (push (make-unprintable-object
+                           "unavailable &REST argument")

                           results)))))
       (sb!di:lambda-list-unavailable
        ()
        (push (make-unprintable-object "lambda list unavailable") results)))
                           results)))))
       (sb!di:lambda-list-unavailable
        ()
        (push (make-unprintable-object "lambda list unavailable") results)))

-    (prin1 (mapcar #'ensure-printable-object (nreverse results)))
-    (when (sb!di:debug-function-kind d-fun)
+    (pprint-logical-block (*standard-output* nil)
+      (let ((x (nreverse (mapcar #'ensure-printable-object results))))
+       (format t "(~@<~S~{ ~_~S~}~:>)" (first x) (rest x))))
+    (when (sb!di:debug-fun-kind d-fun)

       (write-char #\[)
       (write-char #\[)

-      (prin1 (sb!di:debug-function-kind d-fun))
+      (prin1 (sb!di:debug-fun-kind d-fun))

       (write-char #\]))))
 
 (defun ensure-printable-object (object)
       (write-char #\]))))
 
 (defun ensure-printable-object (object)

@@ -539,13 +535,13 @@ Function and macro commands:
 
 (defun frame-call-arg (var location frame)
   (lambda-var-dispatch var location
 
 (defun frame-call-arg (var location frame)
   (lambda-var-dispatch var location

-    (make-unprintable-object "unused arg")
+    (make-unprintable-object "unused argument")

     (sb!di:debug-var-value var frame)
     (sb!di:debug-var-value var frame)

-    (make-unprintable-object "unavailable arg")))
+    (make-unprintable-object "unavailable argument")))

 
 

-;;; Prints a representation of the function call causing frame to
-;;; exist. Verbosity indicates the level of information to output;
-;;; zero indicates just printing the debug-function's name, and one
+;;; Prints a representation of the function call causing FRAME to
+;;; exist. VERBOSITY indicates the level of information to output;
+;;; zero indicates just printing the DEBUG-FUN's name, and one

 ;;; indicates displaying call-like, one-liner format with argument
 ;;; values.
 (defun print-frame-call (frame &key (verbosity 1) (number nil))
 ;;; indicates displaying call-like, one-liner format with argument
 ;;; values.
 (defun print-frame-call (frame &key (verbosity 1) (number nil))

@@ -588,31 +584,37 @@ Function and macro commands:
   (let ((old-hook *debugger-hook*))
     (when old-hook
       (let ((*debugger-hook* nil))
   (let ((old-hook *debugger-hook*))
     (when old-hook
       (let ((*debugger-hook* nil))

-       (funcall hook condition hook))))
+       (funcall old-hook condition old-hook))))

   (sb!unix:unix-sigsetmask 0)
   (sb!unix:unix-sigsetmask 0)

-  (let ((original-package *package*)) ; protect it from WITH-STANDARD-IO-SYNTAX
+
+  ;; Elsewhere in the system, we use the SANE-PACKAGE function for
+  ;; this, but here causing an exception just as we're trying to handle
+  ;; an exception would be confusing, so instead we use a special hack.
+  (unless (and (packagep *package*)
+              (package-name *package*))
+    (setf *package* (find-package :cl-user))
+    (format *error-output*
+           "The value of ~S was not an undeleted PACKAGE. It has been
+reset to ~S."
+           '*package* *package*))
+  (let (;; Save *PACKAGE* to protect it from WITH-STANDARD-IO-SYNTAX.
+       (original-package *package*))

     (with-standard-io-syntax
      (let* ((*debug-condition* condition)
            (*debug-restarts* (compute-restarts condition))
     (with-standard-io-syntax
      (let* ((*debug-condition* condition)
            (*debug-restarts* (compute-restarts condition))

-           ;; FIXME: The next two bindings seem flaky, violating the
-           ;; principle of least surprise. But in order to fix them, we'd
-           ;; need to go through all the i/o statements in the debugger,
-           ;; since a lot of them do their thing on *STANDARD-INPUT* and
-           ;; *STANDARD-OUTPUT* instead of *DEBUG-IO*.
-           (*standard-input* *debug-io*) ; in case of setq
-           (*standard-output* *debug-io*) ; ''  ''  ''  ''
-           ;; We also want to set the i/o subsystem into a known, useful 
-           ;; state, regardless of where in the debugger was invoked in the 
-           ;; program. WITH-STANDARD-IO-SYNTAX does some of that, but
-           ;;   1. It doesn't affect our internal special variables like
-           ;;      *CURRENT-LEVEL*.
+           ;; We want the i/o subsystem to be in a known, useful
+           ;; state, regardless of where the debugger was invoked in
+           ;; the program. WITH-STANDARD-IO-SYNTAX does some of that,
+           ;; but
+           ;;   1. It doesn't affect our internal special variables 
+           ;;      like *CURRENT-LEVEL*.

            ;;   2. It isn't customizable.
            ;;   2. It isn't customizable.

-           ;;   3. It doesn't set *PRINT-READABLY* or *PRINT-PRETTY* to the
-           ;;      same value as the toplevel default.
+           ;;   3. It doesn't set *PRINT-READABLY* or *PRINT-PRETTY* 
+           ;;      to the same value as the toplevel default.

            ;;   4. It sets *PACKAGE* to COMMON-LISP-USER, which is not
            ;;      helpful behavior for a debugger.
            ;;   4. It sets *PACKAGE* to COMMON-LISP-USER, which is not
            ;;      helpful behavior for a debugger.

-           ;; We try to remedy all these problems with explicit rebindings
-           ;; here.
+           ;; We try to remedy all these problems with explicit 
+           ;; rebindings here.

            (sb!kernel:*current-level* 0)
            (*print-length* *debug-print-length*)
            (*print-level* *debug-print-level*)
            (sb!kernel:*current-level* 0)
            (*print-length* *debug-print-length*)
            (*print-level* *debug-print-level*)

@@ -620,54 +622,105 @@ Function and macro commands:
            (*print-readably* nil)
            (*print-pretty* t)
            (*package* original-package))
            (*print-readably* nil)
            (*print-pretty* t)
            (*package* original-package))

-       (format *error-output*
-              "~2&debugger invoked on ~S of type ~S:~%  ~A~%"
-              '*debug-condition*
-              (type-of *debug-condition*)
-              *debug-condition*)
-       (let (;; FIXME: like the bindings of *STANDARD-INPUT* and
-            ;; *STANDARD-OUTPUT* above..
+
+       ;; Before we start our own output, finish any pending output.
+       ;; Otherwise, if the user tried to track the progress of
+       ;; his program using PRINT statements, he'd tend to lose
+       ;; the last line of output or so, and get confused.
+       (flush-standard-output-streams)
+
+       ;; (The initial output here goes to *ERROR-OUTPUT*, because the
+       ;; initial output is not interactive, just an error message,
+       ;; and when people redirect *ERROR-OUTPUT*, they could
+       ;; reasonably expect to see error messages logged there,
+       ;; regardless of what the debugger does afterwards.)
+       (handler-case
+          (format *error-output*
+                  "~2&~@<debugger invoked on condition of type ~S: ~
+                    ~2I~_~A~:>~%"
+                  (type-of *debug-condition*)
+                  *debug-condition*)
+        (error (condition)
+          (format *error-output*
+                  "~&(caught ~S trying to print ~S when entering debugger)~%"
+                  (type-of condition)
+                  '*debug-condition*)))
+
+       ;; After the initial error/condition/whatever announcement to
+       ;; *ERROR-OUTPUT*, we become interactive, and should talk on
+       ;; *DEBUG-IO* from now on. (KLUDGE: This is a normative
+       ;; statement, not a description of reality.:-| There's a lot of
+       ;; older debugger code which was written to do i/o on whatever
+       ;; stream was in fashion at the time, and not all of it has
+       ;; been converted to behave this way. -- WHN 2000-11-16)
+       (let (;; FIXME: The first two bindings here seem wrong,
+            ;; violating the principle of least surprise, and making
+            ;; it impossible for the user to do reasonable things
+            ;; like using PRINT at the debugger prompt to send output
+            ;; to the program's ordinary (possibly
+            ;; redirected-to-a-file) *STANDARD-OUTPUT*, or using
+            ;; PEEK-CHAR or some such thing on the program's ordinary
+            ;; (possibly also redirected) *STANDARD-INPUT*.
+            (*standard-input* *debug-io*)
+            (*standard-output* *debug-io*)
+            ;; This seems reasonable: e.g. if the user has redirected
+            ;; *ERROR-OUTPUT* to some log file, it's probably wrong
+            ;; to send errors which occur in interactive debugging to
+            ;; that file, and right to send them to *DEBUG-IO*.

             (*error-output* *debug-io*))
         (unless (typep condition 'step-condition)
             (*error-output* *debug-io*))
         (unless (typep condition 'step-condition)

-          (show-restarts *debug-restarts* *error-output*))
+          (when *debug-beginner-help-p*
+            (format *debug-io*
+                    "~%~@<Within the debugger, you can type HELP for help. ~
+                      At any command prompt (within the debugger or not) you ~
+                      can type (SB-EXT:QUIT) to terminate the SBCL ~
+                      executable. The condition which caused the debugger to ~
+                      be entered is bound to ~S. You can suppress this ~
+                      message by clearing ~S.~:@>~2%"
+                    '*debug-condition*
+                    '*debug-beginner-help-p*))
+          (show-restarts *debug-restarts* *debug-io*))

         (internal-debug))))))
 
         (internal-debug))))))
 

-(defun show-restarts (restarts &optional (s *error-output*))
-  (when restarts
-    (format s "~&restarts:~%")
-    (let ((count 0)
-         (names-used '(nil))
-         (max-name-len 0))
-      (dolist (restart restarts)
-       (let ((name (restart-name restart)))
-         (when name
-           (let ((len (length (princ-to-string name))))
-             (when (> len max-name-len)
-               (setf max-name-len len))))))
-      (unless (zerop max-name-len)
-       (incf max-name-len 3))
-      (dolist (restart restarts)
-       (let ((name (restart-name restart)))
-         (cond ((member name names-used)
-                (format s "~& ~2D: ~@VT~A~%" count max-name-len restart))
-               (t
-                (format s "~& ~2D: [~VA] ~A~%"
-                        count (- max-name-len 3) name restart)
-                (push name names-used))))
-       (incf count)))))
-
-;;; This calls DEBUG-LOOP, performing some simple initializations before doing
-;;; so. INVOKE-DEBUGGER calls this to actually get into the debugger.
-;;; SB!CONDITIONS::ERROR-ERROR calls this in emergencies to get into a debug
-;;; prompt as quickly as possible with as little risk as possible for stepping
-;;; on whatever is causing recursive errors.
+(defun show-restarts (restarts s)
+  (cond ((null restarts)
+        (format s
+                "~&(no restarts: If you didn't do this on purpose, ~
+                  please report it as a bug.)~%"))
+       (t
+        (format s "~&restarts:~%")
+        (let ((count 0)
+              (names-used '(nil))
+              (max-name-len 0))
+          (dolist (restart restarts)
+            (let ((name (restart-name restart)))
+              (when name
+                (let ((len (length (princ-to-string name))))
+                  (when (> len max-name-len)
+                    (setf max-name-len len))))))
+          (unless (zerop max-name-len)
+            (incf max-name-len 3))
+          (dolist (restart restarts)
+            (let ((name (restart-name restart)))
+              (cond ((member name names-used)
+                     (format s "~& ~2D: ~@VT~A~%" count max-name-len restart))
+                    (t
+                     (format s "~& ~2D: [~VA] ~A~%"
+                             count (- max-name-len 3) name restart)
+                     (push name names-used))))
+            (incf count))))))
+
+;;; This calls DEBUG-LOOP, performing some simple initializations
+;;; before doing so. INVOKE-DEBUGGER calls this to actually get into
+;;; the debugger. SB!KERNEL::ERROR-ERROR calls this in emergencies
+;;; to get into a debug prompt as quickly as possible with as little
+;;; risk as possible for stepping on whatever is causing recursive
+;;; errors.

 (defun internal-debug ()
   (let ((*in-the-debugger* t)
        (*read-suppress* nil))
     (unless (typep *debug-condition* 'step-condition)
 (defun internal-debug ()
   (let ((*in-the-debugger* t)
        (*read-suppress* nil))
     (unless (typep *debug-condition* 'step-condition)

-      (clear-input *debug-io*)
-      (format *debug-io*
-             "~&Within the debugger, you can type HELP for help.~%"))
+      (clear-input *debug-io*))

     #!-mp (debug-loop)
     #!+mp (sb!mp:without-scheduling (debug-loop))))
 \f
     #!-mp (debug-loop)
     #!+mp (sb!mp:without-scheduling (debug-loop))))
 \f

@@ -686,30 +739,36 @@ Function and macro commands:
         (*stack-top* (or *stack-top-hint* *real-stack-top*))
         (*stack-top-hint* nil)
         (*current-frame* *stack-top*))
         (*stack-top* (or *stack-top-hint* *real-stack-top*))
         (*stack-top-hint* nil)
         (*current-frame* *stack-top*))

-    (handler-bind ((sb!di:debug-condition (lambda (condition)
-                                           (princ condition *debug-io*)
-                                           (throw 'debug-loop-catcher nil))))
+    (handler-bind ((sb!di:debug-condition
+                   (lambda (condition)
+                     (princ condition *debug-io*)
+                     (/show0 "handling d-c by THROWing DEBUG-LOOP-CATCHER")
+                     (throw 'debug-loop-catcher nil))))

       (fresh-line)
       (print-frame-call *current-frame* :verbosity 2)
       (loop
        (catch 'debug-loop-catcher
       (fresh-line)
       (print-frame-call *current-frame* :verbosity 2)
       (loop
        (catch 'debug-loop-catcher

-         (handler-bind ((error #'(lambda (condition)
-                                   (when *flush-debug-errors*
-                                     (clear-input *debug-io*)
-                                     (princ condition)
-                                     ;; FIXME: Doing input on *DEBUG-IO*
-                                     ;; and output on T seems broken.
-                                     (format t
-                                             "~&error flushed (because ~
-                                              ~S is set)"
-                                             '*flush-debug-errors*)
-                                     (throw 'debug-loop-catcher nil)))))
+         (handler-bind ((error (lambda (condition)
+                                 (when *flush-debug-errors*
+                                   (clear-input *debug-io*)
+                                   (princ condition)
+                                   ;; FIXME: Doing input on *DEBUG-IO*
+                                   ;; and output on T seems broken.
+                                   (format t
+                                           "~&error flushed (because ~
+                                            ~S is set)"
+                                           '*flush-debug-errors*)
+                                   (/show0 "throwing DEBUG-LOOP-CATCHER")
+                                   (throw 'debug-loop-catcher nil)))))

            ;; We have to bind level for the restart function created by
            ;; WITH-SIMPLE-RESTART.
            (let ((level *debug-command-level*)
                  (restart-commands (make-restart-commands)))
            ;; We have to bind level for the restart function created by
            ;; WITH-SIMPLE-RESTART.
            (let ((level *debug-command-level*)
                  (restart-commands (make-restart-commands)))

-             (with-simple-restart (abort "Return to debug level ~D." level)
-               (funcall *debug-prompt*)
+             (with-simple-restart (abort
+                                  "Reduce debugger level (to debug level ~W)."
+                                   level)
+               (debug-prompt *debug-io*)
+               (force-output *debug-io*)

                (let ((input (sb!int:get-stream-command *debug-io*)))
                  (cond (input
                         (let ((cmd-fun (debug-command-p
                (let ((input (sb!int:get-stream-command *debug-io*)))
                  (cond (input
                         (let ((cmd-fun (debug-command-p

@@ -738,20 +797,14 @@ Function and macro commands:
                                 (t
                                  (funcall cmd-fun)))))))))))))))
 
                                 (t
                                  (funcall cmd-fun)))))))))))))))
 

-(defvar *auto-eval-in-frame* t
-  #!+sb-doc
-  "When set (the default), evaluations in the debugger's command loop occur
-   relative to the current frame's environment without the need of debugger
-   forms that explicitly control this kind of evaluation.")
-

 ;;; FIXME: We could probably use INTERACTIVE-EVAL for much of this logic.
 ;;; FIXME: We could probably use INTERACTIVE-EVAL for much of this logic.

-(defun debug-eval-print (exp)
-  (setq +++ ++ ++ + + - - exp)
-  (let* ((values (multiple-value-list
-                 (if (and (fboundp 'compile) *auto-eval-in-frame*)
-                     (sb!di:eval-in-frame *current-frame* -)
-                     (eval -))))
+(defun debug-eval-print (expr)
+  (/noshow "entering DEBUG-EVAL-PRINT" expr)
+  (/noshow (fboundp 'compile))
+  (setq +++ ++ ++ + + - - expr)
+  (let* ((values (multiple-value-list (eval -)))

         (*standard-output* *debug-io*))
         (*standard-output* *debug-io*))

+    (/noshow "done with EVAL in DEBUG-EVAL-PRINT")

     (fresh-line)
     (if values (prin1 (car values)))
     (dolist (x (cdr values))
     (fresh-line)
     (if values (prin1 (car values)))
     (dolist (x (cdr values))

@@ -763,31 +816,29 @@ Function and macro commands:
     (unless (boundp '*)
       (setq * nil)
       (fresh-line)
     (unless (boundp '*)
       (setq * nil)
       (fresh-line)

-      ;; FIXME: Perhaps this shouldn't be WARN (for fear of complicating
-      ;; the debugging situation?) but at least it should go to *ERROR-OUTPUT*.
-      ;; (And probably it should just be WARN.)
+      ;; FIXME: The way INTERACTIVE-EVAL does this seems better.

       (princ "Setting * to NIL (was unbound marker)."))))
 \f
 ;;;; debug loop functions
 
       (princ "Setting * to NIL (was unbound marker)."))))
 \f
 ;;;; debug loop functions
 

-;;; These commands are functions, not really commands, so that users can get
-;;; their hands on the values returned.
+;;; These commands are functions, not really commands, so that users
+;;; can get their hands on the values returned.

 
 (eval-when (:execute :compile-toplevel)
 
 (sb!xc:defmacro define-var-operation (ref-or-set &optional value-var)
   `(let* ((temp (etypecase name
 
 (eval-when (:execute :compile-toplevel)
 
 (sb!xc:defmacro define-var-operation (ref-or-set &optional value-var)
   `(let* ((temp (etypecase name

-                 (symbol (sb!di:debug-function-symbol-variables
-                          (sb!di:frame-debug-function *current-frame*)
+                 (symbol (sb!di:debug-fun-symbol-variables
+                          (sb!di:frame-debug-fun *current-frame*)

                           name))
                  (simple-string (sb!di:ambiguous-debug-vars
                           name))
                  (simple-string (sb!di:ambiguous-debug-vars

-                                 (sb!di:frame-debug-function *current-frame*)
+                                 (sb!di:frame-debug-fun *current-frame*)

                                  name))))
          (location (sb!di:frame-code-location *current-frame*))
          ;; Let's only deal with valid variables.
                                  name))))
          (location (sb!di:frame-code-location *current-frame*))
          ;; Let's only deal with valid variables.

-         (vars (remove-if-not #'(lambda (v)
-                                  (eq (sb!di:debug-var-validity v location)
-                                      :valid))
+         (vars (remove-if-not (lambda (v)
+                                (eq (sb!di:debug-var-validity v location)
+                                    :valid))

                               temp)))
      (declare (list vars))
      (cond ((null vars)
                               temp)))
      (declare (list vars))
      (cond ((null vars)

@@ -800,8 +851,8 @@ Function and macro commands:
                `(setf (sb!di:debug-var-value (car vars) *current-frame*)
                       ,value-var))))
           (t
                `(setf (sb!di:debug-var-value (car vars) *current-frame*)
                       ,value-var))))
           (t

-           ;; Since we have more than one, first see whether we have any
-           ;; variables that exactly match the specification.
+           ;; Since we have more than one, first see whether we have
+           ;; any variables that exactly match the specification.

            (let* ((name (etypecase name
                           (symbol (symbol-name name))
                           (simple-string name)))
            (let* ((name (etypecase name
                           (symbol (symbol-name name))
                           (simple-string name)))

@@ -823,26 +874,27 @@ Function and macro commands:
                   (:set
                    `(setf (sb!di:debug-var-value (car vars) *current-frame*)
                           ,value-var))))
                   (:set
                    `(setf (sb!di:debug-var-value (car vars) *current-frame*)
                           ,value-var))))

-              ;; If there weren't any exact matches, flame about ambiguity
-              ;; unless all the variables have the same name.
+              ;; If there weren't any exact matches, flame about
+              ;; ambiguity unless all the variables have the same
+              ;; name.

               ((and (not exact)
                     (find-if-not
               ((and (not exact)
                     (find-if-not

-                     #'(lambda (v)
-                         (string= (sb!di:debug-var-symbol-name v)
-                                  (sb!di:debug-var-symbol-name (car vars))))
+                     (lambda (v)
+                       (string= (sb!di:debug-var-symbol-name v)
+                                (sb!di:debug-var-symbol-name (car vars))))

                      (cdr vars)))
                (error "specification ambiguous:~%~{   ~A~%~}"
                       (mapcar #'sb!di:debug-var-symbol-name
                               (delete-duplicates
                                vars :test #'string=
                                :key #'sb!di:debug-var-symbol-name))))
                      (cdr vars)))
                (error "specification ambiguous:~%~{   ~A~%~}"
                       (mapcar #'sb!di:debug-var-symbol-name
                               (delete-duplicates
                                vars :test #'string=
                                :key #'sb!di:debug-var-symbol-name))))

-              ;; All names are the same, so see whether the user ID'ed one of
-              ;; them.
+              ;; All names are the same, so see whether the user
+              ;; ID'ed one of them.

               (id-supplied
                (let ((v (find id vars :key #'sb!di:debug-var-id)))
                  (unless v
                    (error
               (id-supplied
                (let ((v (find id vars :key #'sb!di:debug-var-id)))
                  (unless v
                    (error

-                    "invalid variable ID, ~D: should have been one of ~S"
+                    "invalid variable ID, ~W: should have been one of ~S"

                     id
                     (mapcar #'sb!di:debug-var-id vars)))
                  ,(ecase ref-or-set
                     id
                     (mapcar #'sb!di:debug-var-id vars)))
                  ,(ecase ref-or-set

@@ -858,9 +910,11 @@ Function and macro commands:
 
 ) ; EVAL-WHEN
 
 
 ) ; EVAL-WHEN
 

+;;; FIXME: This doesn't work. It would be real nice we could make it
+;;; work! Alas, it doesn't seem to work in CMU CL X86 either..

 (defun var (name &optional (id 0 id-supplied))
   #!+sb-doc
 (defun var (name &optional (id 0 id-supplied))
   #!+sb-doc

-  "Returns a variable's value if possible. Name is a simple-string or symbol.
+  "Return a variable's value if possible. NAME is a simple-string or symbol.

    If it is a simple-string, it is an initial substring of the variable's name.
    If name is a symbol, it has the same name and package as the variable whose
    value this function returns. If the symbol is uninterned, then the variable
    If it is a simple-string, it is an initial substring of the variable's name.
    If name is a symbol, it has the same name and package as the variable whose
    value this function returns. If the symbol is uninterned, then the variable

@@ -879,11 +933,11 @@ Function and macro commands:
 (defun (setf var) (value name &optional (id 0 id-supplied))
   (define-var-operation :set value))
 
 (defun (setf var) (value name &optional (id 0 id-supplied))
   (define-var-operation :set value))
 

-;;; This returns the COUNT'th arg as the user sees it from args, the result of
-;;; SB!DI:DEBUG-FUNCTION-LAMBDA-LIST. If this returns a potential
-;;; DEBUG-VAR from the lambda-list, then the second value is T. If this
-;;; returns a keyword symbol or a value from a rest arg, then the second value
-;;; is NIL.
+;;; This returns the COUNT'th arg as the user sees it from args, the
+;;; result of SB!DI:DEBUG-FUN-LAMBDA-LIST. If this returns a
+;;; potential DEBUG-VAR from the lambda-list, then the second value is
+;;; T. If this returns a keyword symbol or a value from a rest arg,
+;;; then the second value is NIL.

 (declaim (ftype (function (index list)) nth-arg))
 (defun nth-arg (count args)
   (let ((n count))
 (declaim (ftype (function (index list)) nth-arg))
 (defun nth-arg (count args)
   (let ((n count))

@@ -900,7 +954,8 @@ Function and macro commands:
        :rest ((let ((var (second ele)))
                 (lambda-var-dispatch var (sb!di:frame-code-location
                                           *current-frame*)
        :rest ((let ((var (second ele)))
                 (lambda-var-dispatch var (sb!di:frame-code-location
                                           *current-frame*)

-                  (error "unused REST-arg before n'th argument")
+                  (error "unused &REST argument before n'th
+argument")

                   (dolist (value
                            (sb!di:debug-var-value var *current-frame*)
                            (error
                   (dolist (value
                            (sb!di:debug-var-value var *current-frame*)
                            (error

@@ -909,17 +964,17 @@ Function and macro commands:
                     (if (zerop n)
                         (return-from nth-arg (values value nil))
                         (decf n)))
                     (if (zerop n)
                         (return-from nth-arg (values value nil))
                         (decf n)))

-                  (error "invalid REST-arg before n'th argument")))))
+                  (error "invalid &REST argument before n'th argument")))))

       (decf n))))
 
 (defun arg (n)
   #!+sb-doc
       (decf n))))
 
 (defun arg (n)
   #!+sb-doc

-  "Returns the N'th argument's value if possible. Argument zero is the first
+  "Return the N'th argument's value if possible. Argument zero is the first

    argument in a frame's default printed representation. Count keyword/value
    pairs as separate arguments."
   (multiple-value-bind (var lambda-var-p)
    argument in a frame's default printed representation. Count keyword/value
    pairs as separate arguments."
   (multiple-value-bind (var lambda-var-p)

-      (nth-arg n (handler-case (sb!di:debug-function-lambda-list
-                               (sb!di:frame-debug-function *current-frame*))
+      (nth-arg n (handler-case (sb!di:debug-fun-lambda-list
+                               (sb!di:frame-debug-fun *current-frame*))

                   (sb!di:lambda-list-unavailable ()
                     (error "No argument values are available."))))
     (if lambda-var-p
                   (sb!di:lambda-list-unavailable ()
                     (error "No argument values are available."))))
     (if lambda-var-p

@@ -935,10 +990,8 @@ Function and macro commands:
 
 ;;; Interface to *DEBUG-COMMANDS*. No required arguments in args are
 ;;; permitted.
 
 ;;; Interface to *DEBUG-COMMANDS*. No required arguments in args are
 ;;; permitted.

-;;;
-;;; FIXME: This is not needed in the target Lisp system.
-(defmacro def-debug-command (name args &rest body)
-  (let ((fun-name (intern (concatenate 'simple-string name "-DEBUG-COMMAND"))))
+(defmacro !def-debug-command (name args &rest body)
+  (let ((fun-name (symbolicate name "-DEBUG-COMMAND")))

     `(progn
        (setf *debug-commands*
             (remove ,name *debug-commands* :key #'car :test #'string=))
     `(progn
        (setf *debug-commands*
             (remove ,name *debug-commands* :key #'car :test #'string=))

@@ -949,24 +1002,25 @@ Function and macro commands:
        (push (cons ,name #',fun-name) *debug-commands*)
        ',fun-name)))
 
        (push (cons ,name #',fun-name) *debug-commands*)
        ',fun-name)))
 

-(defun def-debug-command-alias (new-name existing-name)
+(defun !def-debug-command-alias (new-name existing-name)

   (let ((pair (assoc existing-name *debug-commands* :test #'string=)))
     (unless pair (error "unknown debug command name: ~S" existing-name))
     (push (cons new-name (cdr pair)) *debug-commands*))
   new-name)
 
   (let ((pair (assoc existing-name *debug-commands* :test #'string=)))
     (unless pair (error "unknown debug command name: ~S" existing-name))
     (push (cons new-name (cdr pair)) *debug-commands*))
   new-name)
 

-;;; This takes a symbol and uses its name to find a debugger command, using
-;;; initial substring matching. It returns the command function if form
-;;; identifies only one command, but if form is ambiguous, this returns a list
-;;; of the command names. If there are no matches, this returns nil. Whenever
-;;; the loop that looks for a set of possibilities encounters an exact name
-;;; match, we return that command function immediately.
+;;; This takes a symbol and uses its name to find a debugger command,
+;;; using initial substring matching. It returns the command function
+;;; if form identifies only one command, but if form is ambiguous,
+;;; this returns a list of the command names. If there are no matches,
+;;; this returns nil. Whenever the loop that looks for a set of
+;;; possibilities encounters an exact name match, we return that
+;;; command function immediately.

 (defun debug-command-p (form &optional other-commands)
   (if (or (symbolp form) (integerp form))
       (let* ((name
              (if (symbolp form)
                  (symbol-name form)
 (defun debug-command-p (form &optional other-commands)
   (if (or (symbolp form) (integerp form))
       (let* ((name
              (if (symbolp form)
                  (symbol-name form)

-                 (format nil "~D" form)))
+                 (format nil "~W" form)))

             (len (length name))
             (res nil))
        (declare (simple-string name)
             (len (length name))
             (res nil))
        (declare (simple-string name)

@@ -997,29 +1051,31 @@ Function and macro commands:
                   ((not cmds) res)
                 (setf (car cmds) (caar cmds))))))))
 
                   ((not cmds) res)
                 (setf (car cmds) (caar cmds))))))))
 

-;;; Returns a list of debug commands (in the same format as *debug-commands*)
-;;; that invoke each active restart.
+;;; Return a list of debug commands (in the same format as
+;;; *DEBUG-COMMANDS*) that invoke each active restart.

 ;;;
 ;;;

-;;; Two commands are made for each restart: one for the number, and one for
-;;; the restart name (unless it's been shadowed by an earlier restart of the
-;;; same name).
+;;; Two commands are made for each restart: one for the number, and
+;;; one for the restart name (unless it's been shadowed by an earlier
+;;; restart of the same name, or it is NIL).

 (defun make-restart-commands (&optional (restarts *debug-restarts*))
   (let ((commands)
        (num 0))                        ; better be the same as show-restarts!
     (dolist (restart restarts)
       (let ((name (string (restart-name restart))))
 (defun make-restart-commands (&optional (restarts *debug-restarts*))
   (let ((commands)
        (num 0))                        ; better be the same as show-restarts!
     (dolist (restart restarts)
       (let ((name (string (restart-name restart))))

-       (unless (find name commands :key #'car :test #'string=)
-         (let ((restart-fun
-                #'(lambda ()
-                    (invoke-restart-interactively restart))))
-           (push (cons name restart-fun) commands)
-           (push (cons (format nil "~D" num) restart-fun) commands))))
-      (incf num))
-    commands))
+        (let ((restart-fun
+                (lambda ()
+                 (/show0 "in restart-command closure, about to i-r-i")
+                 (invoke-restart-interactively restart))))
+          (push (cons (prin1-to-string num) restart-fun) commands)
+          (unless (or (null (restart-name restart)) 
+                      (find name commands :key #'car :test #'string=))
+            (push (cons name restart-fun) commands))))
+    (incf num))
+  commands))

 \f
 ;;;; frame-changing commands
 
 \f
 ;;;; frame-changing commands
 

-(def-debug-command "UP" ()
+(!def-debug-command "UP" ()

   (let ((next (sb!di:frame-up *current-frame*)))
     (cond (next
           (setf *current-frame* next)
   (let ((next (sb!di:frame-up *current-frame*)))
     (cond (next
           (setf *current-frame* next)

@@ -1027,7 +1083,7 @@ Function and macro commands:
          (t
           (format t "~&Top of stack.")))))
 
          (t
           (format t "~&Top of stack.")))))
 

-(def-debug-command "DOWN" ()
+(!def-debug-command "DOWN" ()

   (let ((next (sb!di:frame-down *current-frame*)))
     (cond (next
           (setf *current-frame* next)
   (let ((next (sb!di:frame-down *current-frame*)))
     (cond (next
           (setf *current-frame* next)

@@ -1035,26 +1091,29 @@ Function and macro commands:
          (t
           (format t "~&Bottom of stack.")))))
 
          (t
           (format t "~&Bottom of stack.")))))
 

-(def-debug-command-alias "D" "DOWN")
+(!def-debug-command-alias "D" "DOWN")

 
 

-(def-debug-command "TOP" ()
-  (do ((prev *current-frame* lead)
-       (lead (sb!di:frame-up *current-frame*) (sb!di:frame-up lead)))
-      ((null lead)
-       (setf *current-frame* prev)
-       (print-frame-call prev))))
+;;; CMU CL had this command, but SBCL doesn't, since it's redundant
+;;; with "FRAME 0", and it interferes with abbreviations for the
+;;; TOPLEVEL restart.
+;;;(!def-debug-command "TOP" ()
+;;;  (do ((prev *current-frame* lead)
+;;;       (lead (sb!di:frame-up *current-frame*) (sb!di:frame-up lead)))
+;;;      ((null lead)
+;;;       (setf *current-frame* prev)
+;;;       (print-frame-call prev))))

 
 

-(def-debug-command "BOTTOM" ()
+(!def-debug-command "BOTTOM" ()

   (do ((prev *current-frame* lead)
        (lead (sb!di:frame-down *current-frame*) (sb!di:frame-down lead)))
       ((null lead)
        (setf *current-frame* prev)
        (print-frame-call prev))))
 
   (do ((prev *current-frame* lead)
        (lead (sb!di:frame-down *current-frame*) (sb!di:frame-down lead)))
       ((null lead)
        (setf *current-frame* prev)
        (print-frame-call prev))))
 

-(def-debug-command-alias "B" "BOTTOM")
+(!def-debug-command-alias "B" "BOTTOM")

 
 

-(def-debug-command "FRAME" (&optional
-                           (n (read-prompting-maybe "frame number: ")))
+(!def-debug-command "FRAME" (&optional
+                            (n (read-prompting-maybe "frame number: ")))

   (setf *current-frame*
        (multiple-value-bind (next-frame-fun limit-string)
            (if (< n (sb!di:frame-number *current-frame*))
   (setf *current-frame*
        (multiple-value-bind (next-frame-fun limit-string)
            (if (< n (sb!di:frame-number *current-frame*))

@@ -1073,21 +1132,32 @@ Function and macro commands:
                     (return frame)))))))
   (print-frame-call *current-frame*))
 
                     (return frame)))))))
   (print-frame-call *current-frame*))
 

-(def-debug-command-alias "F" "FRAME")
+(!def-debug-command-alias "F" "FRAME")

 \f
 ;;;; commands for entering and leaving the debugger
 
 \f
 ;;;; commands for entering and leaving the debugger
 

-(def-debug-command "QUIT" ()
-  (throw 'sb!impl::top-level-catcher nil))
+;;; CMU CL supported this QUIT debug command, but SBCL provides this
+;;; functionality with a restart instead. (The QUIT debug command was
+;;; removed because it's confusing to have "quit" mean two different
+;;; things in the system, "restart the top level REPL" in the debugger
+;;; and "terminate the Lisp system" as the SB-EXT:QUIT function.)
+;;;
+;;;(!def-debug-command "QUIT" ()
+;;;  (throw 'sb!impl::toplevel-catcher nil))

 
 

-(def-debug-command "GO" ()
-  (continue *debug-condition*)
-  (error "There is no restart named CONTINUE."))
+;;; CMU CL supported this GO debug command, but SBCL doesn't -- in
+;;; SBCL you just type the CONTINUE restart name instead (or "RESTART
+;;; CONTINUE", that's OK too).

 
 

-(def-debug-command "RESTART" ()
+;;;(!def-debug-command "GO" ()
+;;;  (continue *debug-condition*)
+;;;  (error "There is no restart named CONTINUE."))
+
+(!def-debug-command "RESTART" ()
+  (/show0 "doing RESTART debug-command")

   (let ((num (read-if-available :prompt)))
     (when (eq num :prompt)
   (let ((num (read-if-available :prompt)))
     (when (eq num :prompt)

-      (show-restarts *debug-restarts*)
+      (show-restarts *debug-restarts* *debug-io*)

       (write-string "restart: ")
       (force-output)
       (setf num (read *standard-input*)))
       (write-string "restart: ")
       (force-output)
       (setf num (read *standard-input*)))

@@ -1096,12 +1166,13 @@ Function and macro commands:
                      (nth num *debug-restarts*))
                     (symbol
                      (find num *debug-restarts* :key #'restart-name
                      (nth num *debug-restarts*))
                     (symbol
                      (find num *debug-restarts* :key #'restart-name

-                           :test #'(lambda (sym1 sym2)
-                                     (string= (symbol-name sym1)
-                                              (symbol-name sym2)))))
+                           :test (lambda (sym1 sym2)
+                                   (string= (symbol-name sym1)
+                                            (symbol-name sym2)))))

                     (t
                      (format t "~S is invalid as a restart name.~%" num)
                      (return-from restart-debug-command nil)))))
                     (t
                      (format t "~S is invalid as a restart name.~%" num)
                      (return-from restart-debug-command nil)))))

+      (/show0 "got RESTART")

       (if restart
          (invoke-restart-interactively restart)
          ;; FIXME: Even if this isn't handled by WARN, it probably
       (if restart
          (invoke-restart-interactively restart)
          ;; FIXME: Even if this isn't handled by WARN, it probably

@@ -1112,33 +1183,33 @@ Function and macro commands:
 \f
 ;;;; information commands
 
 \f
 ;;;; information commands
 

-(def-debug-command "HELP" ()
+(!def-debug-command "HELP" ()

   ;; CMU CL had a little toy pager here, but "if you aren't running
   ;; ILISP (or a smart windowing system, or something) you deserve to
   ;; lose", so we've dropped it in SBCL. However, in case some
   ;; desperate holdout is running this on a dumb terminal somewhere,
   ;; we tell him where to find the message stored as a string.
   (format *debug-io*
   ;; CMU CL had a little toy pager here, but "if you aren't running
   ;; ILISP (or a smart windowing system, or something) you deserve to
   ;; lose", so we've dropped it in SBCL. However, in case some
   ;; desperate holdout is running this on a dumb terminal somewhere,
   ;; we tell him where to find the message stored as a string.
   (format *debug-io*

-         "~&~a~2%(The HELP string is stored in ~S.)~%"
+         "~&~A~2%(The HELP string is stored in ~S.)~%"

          *debug-help-string*
          '*debug-help-string*))
 
          *debug-help-string*
          '*debug-help-string*))
 

-(def-debug-command-alias "?" "HELP")
+(!def-debug-command-alias "?" "HELP")

 
 

-(def-debug-command "ERROR" ()
-  (format t "~A~%" *debug-condition*)
-  (show-restarts *debug-restarts*))
+(!def-debug-command "ERROR" ()
+  (format *debug-io* "~A~%" *debug-condition*)
+  (show-restarts *debug-restarts* *debug-io*))

 
 

-(def-debug-command "BACKTRACE" ()
+(!def-debug-command "BACKTRACE" ()

   (backtrace (read-if-available most-positive-fixnum)))
 
   (backtrace (read-if-available most-positive-fixnum)))
 

-(def-debug-command "PRINT" ()
+(!def-debug-command "PRINT" ()

   (print-frame-call *current-frame*))
 
   (print-frame-call *current-frame*))
 

-(def-debug-command-alias "P" "PRINT")
+(!def-debug-command-alias "P" "PRINT")

 
 

-(def-debug-command "LIST-LOCALS" ()
-  (let ((d-fun (sb!di:frame-debug-function *current-frame*)))
+(!def-debug-command "LIST-LOCALS" ()
+  (let ((d-fun (sb!di:frame-debug-fun *current-frame*)))

     (if (sb!di:debug-var-info-available d-fun)
        (let ((*standard-output* *debug-io*)
              (location (sb!di:frame-code-location *current-frame*))
     (if (sb!di:debug-var-info-available d-fun)
        (let ((*standard-output* *debug-io*)
              (location (sb!di:frame-code-location *current-frame*))

@@ -1151,7 +1222,7 @@ Function and macro commands:
            (setf any-p t)
            (when (eq (sb!di:debug-var-validity v location) :valid)
              (setf any-valid-p t)
            (setf any-p t)
            (when (eq (sb!di:debug-var-validity v location) :valid)
              (setf any-valid-p t)

-             (format t "~S~:[#~D~;~*~]  =  ~S~%"
+             (format t "~S~:[#~W~;~*~]  =  ~S~%"

                      (sb!di:debug-var-symbol v)
                      (zerop (sb!di:debug-var-id v))
                      (sb!di:debug-var-id v)
                      (sb!di:debug-var-symbol v)
                      (zerop (sb!di:debug-var-id v))
                      (sb!di:debug-var-id v)

@@ -1168,17 +1239,18 @@ Function and macro commands:
                    prefix))))
        (write-line "There is no variable information available."))))
 
                    prefix))))
        (write-line "There is no variable information available."))))
 

-(def-debug-command-alias "L" "LIST-LOCALS")
+(!def-debug-command-alias "L" "LIST-LOCALS")

 
 

-(def-debug-command "SOURCE" ()
+(!def-debug-command "SOURCE" ()

   (fresh-line)
   (print-code-location-source-form (sb!di:frame-code-location *current-frame*)
                                   (read-if-available 0)))
 \f
 ;;;; source location printing
 
   (fresh-line)
   (print-code-location-source-form (sb!di:frame-code-location *current-frame*)
                                   (read-if-available 0)))
 \f
 ;;;; source location printing
 

-;;; We cache a stream to the last valid file debug source so that we won't have
-;;; to repeatedly open the file.
+;;; We cache a stream to the last valid file debug source so that we
+;;; won't have to repeatedly open the file.
+;;;

 ;;; KLUDGE: This sounds like a bug, not a feature. Opening files is fast
 ;;; in the 1990s, so the benefit is negligible, less important than the
 ;;; potential of extra confusion if someone changes the source during
 ;;; KLUDGE: This sounds like a bug, not a feature. Opening files is fast
 ;;; in the 1990s, so the benefit is negligible, less important than the
 ;;; potential of extra confusion if someone changes the source during

@@ -1196,43 +1268,44 @@ Function and macro commands:
 (defvar *cached-readtable* nil)
 (declaim (type (or readtable null) *cached-readtable*))
 
 (defvar *cached-readtable* nil)
 (declaim (type (or readtable null) *cached-readtable*))
 

-(pushnew #'(lambda ()
-            (setq *cached-debug-source* nil *cached-source-stream* nil
-                  *cached-readtable* nil))
-        sb!int:*before-save-initializations*)
-
-;;; We also cache the last top-level form that we printed a source for so that
-;;; we don't have to do repeated reads and calls to FORM-NUMBER-TRANSLATIONS.
-(defvar *cached-top-level-form-offset* nil)
-(declaim (type (or index null) *cached-top-level-form-offset*))
-(defvar *cached-top-level-form*)
+(pushnew (lambda ()
+          (setq *cached-debug-source* nil *cached-source-stream* nil
+                *cached-readtable* nil))
+        *before-save-initializations*)
+
+;;; We also cache the last toplevel form that we printed a source for
+;;; so that we don't have to do repeated reads and calls to
+;;; FORM-NUMBER-TRANSLATIONS.
+(defvar *cached-toplevel-form-offset* nil)
+(declaim (type (or index null) *cached-toplevel-form-offset*))
+(defvar *cached-toplevel-form*)

 (defvar *cached-form-number-translations*)
 
 (defvar *cached-form-number-translations*)
 

-;;; Given a code location, return the associated form-number translations and
-;;; the actual top-level form. We check our cache --- if there is a miss, we
-;;; dispatch on the kind of the debug source.
-(defun get-top-level-form (location)
+;;; Given a code location, return the associated form-number
+;;; translations and the actual top level form. We check our cache ---
+;;; if there is a miss, we dispatch on the kind of the debug source.
+(defun get-toplevel-form (location)

   (let ((d-source (sb!di:code-location-debug-source location)))
     (if (and (eq d-source *cached-debug-source*)
   (let ((d-source (sb!di:code-location-debug-source location)))
     (if (and (eq d-source *cached-debug-source*)

-            (eql (sb!di:code-location-top-level-form-offset location)
-                 *cached-top-level-form-offset*))
-       (values *cached-form-number-translations* *cached-top-level-form*)
-       (let* ((offset (sb!di:code-location-top-level-form-offset location))
+            (eql (sb!di:code-location-toplevel-form-offset location)
+                 *cached-toplevel-form-offset*))
+       (values *cached-form-number-translations* *cached-toplevel-form*)
+       (let* ((offset (sb!di:code-location-toplevel-form-offset location))

               (res
                (ecase (sb!di:debug-source-from d-source)
               (res
                (ecase (sb!di:debug-source-from d-source)

-                 (:file (get-file-top-level-form location))
+                 (:file (get-file-toplevel-form location))

                  (:lisp (svref (sb!di:debug-source-name d-source) offset)))))
                  (:lisp (svref (sb!di:debug-source-name d-source) offset)))))

-         (setq *cached-top-level-form-offset* offset)
+         (setq *cached-toplevel-form-offset* offset)

          (values (setq *cached-form-number-translations*
                        (sb!di:form-number-translations res offset))
          (values (setq *cached-form-number-translations*
                        (sb!di:form-number-translations res offset))

-                 (setq *cached-top-level-form* res))))))
+                 (setq *cached-toplevel-form* res))))))

 
 

-;;; Locates the source file (if it still exists) and grabs the top-level form.
-;;; If the file is modified, we use the top-level-form offset instead of the
-;;; recorded character offset.
-(defun get-file-top-level-form (location)
+;;; Locate the source file (if it still exists) and grab the top level
+;;; form. If the file is modified, we use the top level form offset
+;;; instead of the recorded character offset.
+(defun get-file-toplevel-form (location)

   (let* ((d-source (sb!di:code-location-debug-source location))
   (let* ((d-source (sb!di:code-location-debug-source location))

-        (tlf-offset (sb!di:code-location-top-level-form-offset location))
+        (tlf-offset (sb!di:code-location-toplevel-form-offset location))

         (local-tlf-offset (- tlf-offset
                              (sb!di:debug-source-root-number d-source)))
         (char-offset
         (local-tlf-offset (- tlf-offset
                              (sb!di:debug-source-root-number d-source)))
         (char-offset

@@ -1271,10 +1344,10 @@ Function and macro commands:
       (setq *cached-readtable* (copy-readtable))
       (set-dispatch-macro-character
        #\# #\.
       (setq *cached-readtable* (copy-readtable))
       (set-dispatch-macro-character
        #\# #\.

-       #'(lambda (stream sub-char &rest rest)
-          (declare (ignore rest sub-char))
-          (let ((token (read stream t nil t)))
-            (format nil "#.~S" token)))
+       (lambda (stream sub-char &rest rest)
+        (declare (ignore rest sub-char))
+        (let ((token (read stream t nil t)))
+          (format nil "#.~S" token)))

        *cached-readtable*))
     (let ((*readtable* *cached-readtable*))
       (read *cached-source-stream*))))
        *cached-readtable*))
     (let ((*readtable* *cached-readtable*))
       (read *cached-source-stream*))))

@@ -1282,7 +1355,7 @@ Function and macro commands:
 (defun print-code-location-source-form (location context)
   (let* ((location (maybe-block-start-location location))
         (form-num (sb!di:code-location-form-number location)))
 (defun print-code-location-source-form (location context)
   (let* ((location (maybe-block-start-location location))
         (form-num (sb!di:code-location-form-number location)))

-    (multiple-value-bind (translations form) (get-top-level-form location)
+    (multiple-value-bind (translations form) (get-toplevel-form location)

       (unless (< form-num (length translations))
        (error "The source path no longer exists."))
       (prin1 (sb!di:source-path-context form
       (unless (< form-num (length translations))
        (error "The source path no longer exists."))
       (prin1 (sb!di:source-path-context form

@@ -1292,33 +1365,34 @@ Function and macro commands:
 ;;; breakpoint and step commands
 
 ;;; Step to the next code-location.
 ;;; breakpoint and step commands
 
 ;;; Step to the next code-location.

-(def-debug-command "STEP" ()
+(!def-debug-command "STEP" ()

   (setf *number-of-steps* (read-if-available 1))
   (set-step-breakpoint *current-frame*)
   (continue *debug-condition*)
   (error "couldn't continue"))
 
   (setf *number-of-steps* (read-if-available 1))
   (set-step-breakpoint *current-frame*)
   (continue *debug-condition*)
   (error "couldn't continue"))
 

-;;; List possible breakpoint locations, which ones are active, and where GO
-;;; will continue. Set *POSSIBLE-BREAKPOINTS* to the code-locations which can
-;;; then be used by sbreakpoint.
-(def-debug-command "LIST-LOCATIONS" ()
-  (let ((df (read-if-available *default-breakpoint-debug-function*)))
+;;; List possible breakpoint locations, which ones are active, and
+;;; where the CONTINUE restart will transfer control. Set
+;;; *POSSIBLE-BREAKPOINTS* to the code-locations which can then be
+;;; used by sbreakpoint.
+(!def-debug-command "LIST-LOCATIONS" ()
+  (let ((df (read-if-available *default-breakpoint-debug-fun*)))

     (cond ((consp df)
     (cond ((consp df)

-          (setf df (sb!di:function-debug-function (eval df)))
-          (setf *default-breakpoint-debug-function* df))
+          (setf df (sb!di:fun-debug-fun (eval df)))
+          (setf *default-breakpoint-debug-fun* df))

          ((or (eq ':c df)
          ((or (eq ':c df)

-              (not *default-breakpoint-debug-function*))
-          (setf df (sb!di:frame-debug-function *current-frame*))
-          (setf *default-breakpoint-debug-function* df)))
+              (not *default-breakpoint-debug-fun*))
+          (setf df (sb!di:frame-debug-fun *current-frame*))
+          (setf *default-breakpoint-debug-fun* df)))

     (setf *possible-breakpoints* (possible-breakpoints df)))
   (let ((continue-at (sb!di:frame-code-location *current-frame*)))
     (setf *possible-breakpoints* (possible-breakpoints df)))
   (let ((continue-at (sb!di:frame-code-location *current-frame*)))

-    (let ((active (location-in-list *default-breakpoint-debug-function*
-                                   *breakpoints* :function-start))
+    (let ((active (location-in-list *default-breakpoint-debug-fun*
+                                   *breakpoints* :fun-start))

          (here (sb!di:code-location=
          (here (sb!di:code-location=

-                (sb!di:debug-function-start-location
-                 *default-breakpoint-debug-function*) continue-at)))
+                (sb!di:debug-fun-start-location
+                 *default-breakpoint-debug-fun*) continue-at)))

       (when (or active here)
       (when (or active here)

-       (format t "::FUNCTION-START ")
+       (format t "::FUN-START ")

        (when active (format t " *Active*"))
        (when here (format t " *Continue here*"))))
 
        (when active (format t " *Active*"))
        (when here (format t " *Continue here*"))))
 

@@ -1329,8 +1403,8 @@ Function and macro commands:
               (when prev-location
                 (let ((this-num (1- this-num)))
                   (if (= prev-num this-num)
               (when prev-location
                 (let ((this-num (1- this-num)))
                   (if (= prev-num this-num)

-                      (format t "~&~D: " prev-num)
-                      (format t "~&~D-~D: " prev-num this-num)))
+                      (format t "~&~W: " prev-num)
+                      (format t "~&~W-~W: " prev-num this-num)))

                 (print-code-location-source-form prev-location 0)
                 (when *print-location-kind*
                   (format t "~S " (sb!di:code-location-kind prev-location)))
                 (print-code-location-source-form prev-location 0)
                 (when *print-location-kind*
                   (format t "~S " (sb!di:code-location-kind prev-location)))

@@ -1346,9 +1420,9 @@ Function and macro commands:
                    (not prev-location)
                    (not (eq (sb!di:code-location-debug-source code-location)
                             (sb!di:code-location-debug-source prev-location)))
                    (not prev-location)
                    (not (eq (sb!di:code-location-debug-source code-location)
                             (sb!di:code-location-debug-source prev-location)))

-                   (not (eq (sb!di:code-location-top-level-form-offset
+                   (not (eq (sb!di:code-location-toplevel-form-offset

                              code-location)
                              code-location)

-                            (sb!di:code-location-top-level-form-offset
+                            (sb!di:code-location-toplevel-form-offset

                              prev-location)))
                    (not (eq (sb!di:code-location-form-number code-location)
                             (sb!di:code-location-form-number prev-location))))
                              prev-location)))
                    (not (eq (sb!di:code-location-form-number code-location)
                             (sb!di:code-location-form-number prev-location))))

@@ -1357,15 +1431,15 @@ Function and macro commands:
 
          (incf this-num))))
 
 
          (incf this-num))))
 

-    (when (location-in-list *default-breakpoint-debug-function*
+    (when (location-in-list *default-breakpoint-debug-fun*

                            *breakpoints*
                            *breakpoints*

-                           :function-end)
-      (format t "~&::FUNCTION-END *Active* "))))
+                           :fun-end)
+      (format t "~&::FUN-END *Active* "))))

 
 

-(def-debug-command-alias "LL" "LIST-LOCATIONS")
+(!def-debug-command-alias "LL" "LIST-LOCATIONS")

 
 ;;; Set breakpoint at the given number.
 
 ;;; Set breakpoint at the given number.

-(def-debug-command "BREAKPOINT" ()
+(!def-debug-command "BREAKPOINT" ()

   (let ((index (read-prompting-maybe "location number, :START, or :END: "))
        (break t)
        (condition t)
   (let ((index (read-prompting-maybe "location number, :START, or :END: "))
        (break t)
        (condition t)

@@ -1373,7 +1447,7 @@ Function and macro commands:
        (print-functions nil)
        (function nil)
        (bp)
        (print-functions nil)
        (function nil)
        (bp)

-       (place *default-breakpoint-debug-function*))
+       (place *default-breakpoint-debug-fun*))

     (flet ((get-command-line ()
             (let ((command-line nil)
                   (unique '(nil)))
     (flet ((get-command-line ()
             (let ((command-line nil)
                   (unique '(nil)))

@@ -1391,27 +1465,27 @@ Function and macro commands:
                 (:break (setf break (pop command-line)))
                 (:function
                  (setf function (eval (pop command-line)))
                 (:break (setf break (pop command-line)))
                 (:function
                  (setf function (eval (pop command-line)))

-                 (setf *default-breakpoint-debug-function*
-                       (sb!di:function-debug-function function))
-                 (setf place *default-breakpoint-debug-function*)
+                 (setf *default-breakpoint-debug-fun*
+                       (sb!di:fun-debug-fun function))
+                 (setf place *default-breakpoint-debug-fun*)

                  (setf *possible-breakpoints*
                        (possible-breakpoints
                  (setf *possible-breakpoints*
                        (possible-breakpoints

-                        *default-breakpoint-debug-function*))))))
-          (setup-function-start ()
-            (let ((code-loc (sb!di:debug-function-start-location place)))
+                        *default-breakpoint-debug-fun*))))))
+          (setup-fun-start ()
+            (let ((code-loc (sb!di:debug-fun-start-location place)))

               (setf bp (sb!di:make-breakpoint #'main-hook-function
                                               place
               (setf bp (sb!di:make-breakpoint #'main-hook-function
                                               place

-                                              :kind :function-start))
+                                              :kind :fun-start))

               (setf break (sb!di:preprocess-for-eval break code-loc))
               (setf condition (sb!di:preprocess-for-eval condition code-loc))
               (dolist (form print)
                 (push (cons (sb!di:preprocess-for-eval form code-loc) form)
                       print-functions))))
               (setf break (sb!di:preprocess-for-eval break code-loc))
               (setf condition (sb!di:preprocess-for-eval condition code-loc))
               (dolist (form print)
                 (push (cons (sb!di:preprocess-for-eval form code-loc) form)
                       print-functions))))

-          (setup-function-end ()
+          (setup-fun-end ()

             (setf bp
                   (sb!di:make-breakpoint #'main-hook-function
                                          place
             (setf bp
                   (sb!di:make-breakpoint #'main-hook-function
                                          place

-                                         :kind :function-end))
+                                         :kind :fun-end))

             (setf break
                   ;; FIXME: These and any other old (COERCE `(LAMBDA ..) ..)
                   ;; forms should be converted to shiny new (LAMBDA ..) forms.
             (setf break
                   ;; FIXME: These and any other old (COERCE `(LAMBDA ..) ..)
                   ;; forms should be converted to shiny new (LAMBDA ..) forms.

@@ -1443,9 +1517,9 @@ Function and macro commands:
       (set-vars-from-command-line (get-command-line))
       (cond
        ((or (eq index :start) (eq index :s))
       (set-vars-from-command-line (get-command-line))
       (cond
        ((or (eq index :start) (eq index :s))

-       (setup-function-start))
+       (setup-fun-start))

        ((or (eq index :end) (eq index :e))
        ((or (eq index :end) (eq index :e))

-       (setup-function-end))
+       (setup-fun-end))

        (t
        (setup-code-location)))
       (sb!di:activate-breakpoint bp)
        (t
        (setup-code-location)))
       (sb!di:activate-breakpoint bp)

@@ -1463,20 +1537,20 @@ Function and macro commands:
       (print-breakpoint-info (first *breakpoints*))
       (format t "~&added"))))
 
       (print-breakpoint-info (first *breakpoints*))
       (format t "~&added"))))
 

-(def-debug-command-alias "BP" "BREAKPOINT")
+(!def-debug-command-alias "BP" "BREAKPOINT")

 
 ;;; List all breakpoints which are set.
 
 ;;; List all breakpoints which are set.

-(def-debug-command "LIST-BREAKPOINTS" ()
+(!def-debug-command "LIST-BREAKPOINTS" ()

   (setf *breakpoints*
        (sort *breakpoints* #'< :key #'breakpoint-info-breakpoint-number))
   (dolist (info *breakpoints*)
     (print-breakpoint-info info)))
 
   (setf *breakpoints*
        (sort *breakpoints* #'< :key #'breakpoint-info-breakpoint-number))
   (dolist (info *breakpoints*)
     (print-breakpoint-info info)))
 

-(def-debug-command-alias "LB" "LIST-BREAKPOINTS")
-(def-debug-command-alias "LBP" "LIST-BREAKPOINTS")
+(!def-debug-command-alias "LB" "LIST-BREAKPOINTS")
+(!def-debug-command-alias "LBP" "LIST-BREAKPOINTS")

 
 ;;; Remove breakpoint N, or remove all breakpoints if no N given.
 
 ;;; Remove breakpoint N, or remove all breakpoints if no N given.

-(def-debug-command "DELETE-BREAKPOINT" ()
+(!def-debug-command "DELETE-BREAKPOINT" ()

   (let* ((index (read-if-available nil))
         (bp-info
          (find index *breakpoints* :key #'breakpoint-info-breakpoint-number)))
   (let* ((index (read-if-available nil))
         (bp-info
          (find index *breakpoints* :key #'breakpoint-info-breakpoint-number)))

@@ -1491,14 +1565,14 @@ Function and macro commands:
           (setf *breakpoints* nil)
           (format t "all breakpoints deleted~%")))))
 
           (setf *breakpoints* nil)
           (format t "all breakpoints deleted~%")))))
 

-(def-debug-command-alias "DBP" "DELETE-BREAKPOINT")
+(!def-debug-command-alias "DBP" "DELETE-BREAKPOINT")

 \f
 ;;; miscellaneous commands
 
 \f
 ;;; miscellaneous commands
 

-(def-debug-command "DESCRIBE" ()
+(!def-debug-command "DESCRIBE" ()

   (let* ((curloc (sb!di:frame-code-location *current-frame*))
   (let* ((curloc (sb!di:frame-code-location *current-frame*))

-        (debug-fun (sb!di:code-location-debug-function curloc))
-        (function (sb!di:debug-function-function debug-fun)))
+        (debug-fun (sb!di:code-location-debug-fun curloc))
+        (function (sb!di:debug-fun-fun debug-fun)))

     (if function
        (describe function)
        (format t "can't figure out the function for this frame"))))
     (if function
        (describe function)
        (format t "can't figure out the function for this frame"))))