diff --git a/code/debug.lisp b/code/debug.lisp
index ec00d360c03fb918ab57974ddce66d2cac172ffb..6ee94d950c48c83f7fda149a3065a4c6b66b3c87 100644
--- a/code/debug.lisp
+++ b/code/debug.lisp
@@ -7,66 +7,62 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;; Spice Lisp Debugger.
+;;; CMU Common Lisp Debugger.  This is a very basic command-line oriented
+;;; debugger.
 ;;;
-;;; Written by Steve Handerson
-;;; Pages 6 through 9 rewritten by Bill Chiles.
+;;; Written by Bill Chiles.
 ;;;
-;;; **********************************************************************
-;;;
-(in-package "DEBUG" :use '("LISP" "SYSTEM"))
-
 
-(export '(internal-debug *flush-debug-errors* backtrace debug-function
-	  show-all debug-return local show hide argument pc
-	  function-name hide-defaults *debug-print-level*
-	  *debug-print-length* *debug-hidden-functions*))
+(in-package "DEBUG")
 
+(export '(internal-debug *in-the-debugger* backtrace *flush-debug-errors*
+	  *debug-print-level* *debug-print-length* *debug-prompt*))
 
 
 (in-package "LISP")
 (export '(invoke-debugger *debugger-hook*))
 
-
 (in-package "DEBUG")
 
 ;;;
 ;;; Used to communicate to debug-loop that we are at a step breakpoint.
 ;;;
-
 (define-condition step-condition (simple-condition))
   "*Print-level* is bound to this value when debug prints a function call.")
 ;;;; Variables, parameters, and constants.
 
   "*Print-length* is bound to this value when debug prints a function call.")
   null, use *PRINT-LEVEL*")
-(defvar *inside-debugger-p* nil
-  "This is T while evaluating expressions in the debugger.")
-
 
 (defparameter *debug-print-length* 5
   "*PRINT-LENGTH* is bound to this value when debug prints a function call.  If
   null, use *PRINT-LENGTH*.")
 
 (defvar *in-the-debugger* nil
+  "If this is bound before the debugger is invoked, it is used as the stack
+(defvar *stack-top* nil)
+
+;;;; Breakpoint state:
+
+(defvar *only-block-start-locations* nil
   "When true, the LIST-LOCATIONS command only displays block start locations.
-  "The default contents of *debug-prompt*."
    Otherwise, all locations are displayed.")
 
+(defvar *print-location-kind* nil
   "If 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 lambda of no args that prints the debugger prompt on *debug-io*.")
+(defvar *bad-code-location-types* '(:call-site :internal-error))
+(declaim (type list *bad-code-location-types*))
 
 ;;; Code locations of the possible breakpoints
 ;;;
-Prompt is <stack-level>':'<frame-number>(<command-level>*']').
-Frames look like calls, C signifying a catch frame.
-Expressions get evaluated in the frame's lexical environment,
-  setting * and friends like the top level read-eval-print loop.
-Debug commands do not affect * and friends.
+(defvar *possible-breakpoints*)
+(declaim (type list *possible-breakpoints*))
+
+;;; A list of the made and active breakpoints, each is a breakpoint-info
 ;;;
 (defvar *breakpoints* nil)
 (declaim (type list *breakpoints*))
@@ -79,14 +75,9 @@ Debug commands do not affect * and friends.
 (defvar *step-breakpoints* nil)  
 ;;;
 (defvar *number-of-steps* 1)
-  F  go to numbered frame (prompts if not given).
-  S  search for a specified function (prompts), 
-     an optional number of times (does not prompt).
-  R  searches up the stack, optional times.
 (declaim (type integer *number-of-steps*))
 ;;;
 (defvar *default-breakpoint-debug-function* nil)
-  ?              prints all kinds of groovy things.
   L              lists locals in current function.
   P, PP          displays current function call.  
 
@@ -102,95 +93,152 @@ Functions/macros for your enjoyment:
     (setf kind (di:breakpoint-kind (breakpoint-info-breakpoint place)))
     (format t "Cannot step, in elsewhere code~%"))
    (t
-(proclaim '(inline pointer+ stack-ref valid-env-p cstack-pointer-valid-p))
+    (let* ((code-location (di:frame-code-location frame))
+	   (next-code-locations (next-code-locations code-location)))
+      (cond
+       (next-code-locations
+	(dolist (code-location next-code-locations)
+	  (let ((bp-info (location-in-list code-location *breakpoints*)))
+	      (di:deactivate-breakpoint (breakpoint-info-breakpoint bp-info))))
+  (let ((*print-length* *debug-print-length*)
+	(*print-level* *debug-print-level*))
+	    (di:activate-breakpoint bp)
+	    (push (create-breakpoint-info code-location bp 0)
+		  *step-breakpoints*))))
+       (t
+	(let* ((debug-function (di:frame-debug-function *current-frame*))
+	       (bp (di:make-breakpoint #'main-hook-function debug-function
+      (print-frame-call frame))))
 	  (di:activate-breakpoint bp)
-(defun pointer+ (x y)
-  (%primitive sap+ x (ash y 2)))
+;;;
+;;; This is a convenient way to express what to do for each type of lambda-list
+;;; element.
+;;;
+(defmacro lambda-list-element-dispatch (element &key required optional rest
+						keyword deleted)
+  `(etypecase ,element
+(defun print-frame-call (frame &optional
+			       (*print-length* *debug-print-length*)
+			       (*print-level* *debug-print-level*)
+			       (verbosity 1))
+  (ecase verbosity
+    (0 (print frame))
+    (1 (handler-case
+	   (let* ((d-fun (di:frame-debug-function frame))
+		  (loc (di:frame-code-location frame))
+		  (args (di:debug-function-lambda-list d-fun)))
+	     (terpri)
+	     (write-char #\()
+	     (prin1 (di:debug-function-name d-fun))
+	     (dolist (ele args)
+	       (write-char #\space)
+	       (etypecase ele
+		 (di:debug-variable
+		  (print-frame-call-arg ele loc frame))
+		 (cons
+		  (ecase (car ele)
+		    (:optional
+		     (print-frame-call-arg (second ele) loc frame))
+		    (:rest)
+		    (:keyword
+		     (prin1 (second ele))
+		     (write-char #\space)
+		     (print-frame-call-arg (third ele) loc frame))))))
+	     (write-char #\))
+	     (when (di:debug-function-kind d-fun)
+	       (write-string " [")
+	       (prin1 (di:debug-function-kind d-fun))
+	       (write-char #\])))
+	 (di:lambda-list-unavailable ()
+	  (let ((d-fun (di:frame-debug-function frame)))
+	    (format t "(~S <lambda-list-unavailable>)) ~S)"
+		    (di:debug-function-name d-fun)
+		    (di:debug-function-kind d-fun))))))
+    ((2 3 4 5))))
 	     (t ,other)))))
-(defun stack-ref (s n)
-  (%primitive read-control-stack (pointer+ s n)))
-
-(defun escape-reg (f n)
-  (stack-ref f (+ n %escape-frame-general-register-start-slot)))
-
-(defun valid-env-p (env)
-  (and (functionp env)
-       (eql (%primitive get-vector-subtype env)
-	    %function-constants-subtype)))
-
-(defun cstack-pointer-valid-p (x)
-  (and (%primitive pointer< x (%primitive current-sp))
-       (not (%primitive pointer< x
-			(%primitive make-immediate-type 0
-				    %control-stack-type)))))
+(defun print-frame-call-arg (var location frame)
+  (cond ((eq var :deleted)
+	 (write-string "<unused-arg>"))
+	((di:debug-variable-validity var location)
+	 (prin1 (di:debug-variable-value var frame)))
+	(t (write-string "<unavailable-arg>"))))
 
-(defun check-valid (x)
-  (unless (cstack-pointer-valid-p x)
-    (error "Invalid control stack pointer."))
-  x)
 
-(defun print-code-and-stuff (env pc)
-  (let* ((code (%primitive header-ref env %function-code-slot))
-	 (code-int (%primitive make-fixnum code)))
-    (format t "~A, Code = #x~X, PC = ~D"
-	    (%primitive header-ref env %function-name-slot)
-	    (logior code-int (ash %code-type 27))
-	    (- (%primitive make-fixnum pc) code-int))))
-
-;;; Backtrace prints a history of calls on the stack.
+
+;;;; ROBS-BACKTRACE.
 
-(defun backtrace (&optional (frames most-positive-fixnum)
+(defun robs-backtrace (&optional (frames most-positive-fixnum)
 			    (*standard-output* *debug-io*))
   "Show a listing of the call stack going down from the current frame.  Frames
   is how many frames to show."
-  (do ((callee (%primitive current-fp)
-	       (stack-ref callee c::old-fp-save-offset))
+  (do ((callee (system:%primitive current-fp)
+	       (di::stack-ref callee c::old-fp-save-offset))
        (n 0 (1+ n)))
-      ((or (not (cstack-pointer-valid-p callee))
+      ((or (not (di::cstack-pointer-valid-p callee))
 	   (>= n frames))
        (values))
-    (let* ((caller (stack-ref callee c::old-fp-save-offset))
-	   (pc (stack-ref callee c::return-pc-save-offset)))
-      (unless (cstack-pointer-valid-p caller)
+    (let* ((caller (di::stack-ref callee c::old-fp-save-offset))
+	   (pc (di::stack-ref callee c::return-pc-save-offset)))
+      (unless (di::cstack-pointer-valid-p caller)
 	(return (values)))
-      (let ((env (stack-ref caller c::env-save-offset)))
+      (let ((env (di::stack-ref caller c::env-save-offset)))
 	(cond 
 	 ((eql env 0)
-	  (let ((env (escape-reg caller c::env-offset)))
-	    (cond ((eql (%primitive get-type env) %trap-type)
+	  (let ((env (di::escape-register caller c::env-offset)))
+	    (cond ((eql (system:%primitive get-type env) system:%trap-type)
 		   (format t "~%<undefined> ~S"
-			   (escape-reg caller c::call-name-offset))
+			   (di::escape-register caller c::call-name-offset))
 		   (setq callee
 			 (check-valid
-			  (escape-reg caller c::old-fp-offset))))
-		  ((valid-env-p env)
+			  (di::escape-register caller c::old-fp-offset))))
+		  ((di::env-valid-p env)
 		   (format t "~%<escape frame> ")
 		   (print-code-and-stuff
 		    env
-		    (escape-reg caller c::return-pc-offset))
+		    (di::escape-register caller c::return-pc-offset))
 		   (setq callee
 			 (check-valid
-			  (stack-ref callee c::old-fp-save-offset))))
+			  (di::stack-ref callee c::old-fp-save-offset))))
 		  (t
 		   (error "Escaping frame ENV invalid?")))))
-	 ((valid-env-p env)
+	 ((di::env-valid-p env)
 	  (terpri)
 	  (print-code-and-stuff env pc))
 	 (t
 	  (format t "~%<invalid frame>")))))))
 
+(defun print-code-and-stuff (env pc)
+  (let* ((code (system:%primitive header-ref env system:%function-code-slot))
+	 (code-int (system:%primitive make-fixnum code)))
+    (format t "~A, Code = #x~X, PC = ~D"
+	    (system:%primitive header-ref env system:%function-name-slot)
+	    (logior code-int (ash system:%code-type 27))
+	    (- (system:%primitive make-fixnum pc) code-int))))
+
+(defun check-valid (x)
+  (unless (di::cstack-pointer-valid-p x)
+    (error "Invalid control stack pointer."))
+  x)
+    (make-unprintable-object "unused-arg")
+    (di:debug-variable-value var frame)
     (make-unprintable-object "unavailable-arg")))
 ;;;; DEBUG
 ;;; PRINT-FRAME-CALL -- Interface
 ;;;
 ;;; This prints a representation of the function call causing frame to exist.
 ;;; Verbosity indicates the level of information to output; zero indicates just
-   which causes the standard debugger to execute.")
+;;; printing the debug-function's name, and one indicates displaying call-like,
+;;; one-liner format with argument values.
+;;;
 (defun print-frame-call (frame &key (print-length *print-length*)
+			       (print-level *print-level*)
+			       (verbosity 1)
 			       (number nil))
   (let ((*print-length* (or *debug-print-length* print-length))
 (defvar *debug-abort*)
 	(*print-level* (or *debug-print-level* print-level)))
+    (cond
+     ((zerop verbosity)
       (when number
 	(format t "~&~S: " (di:frame-number frame)))
       (format t "~S" frame))
@@ -207,6 +255,8 @@ Functions/macros for your enjoyment:
 ;;;; Invoke-debugger.
 
 (defvar *debugger-hook* nil
+  "This is either nil or a function of two arguments, a condition and the value
+   of *debugger-hook*.  This function can either handle the condition or return
    which causes the standard debugger to execute.  The system passes the value
    of this variable to the function because it binds *debugger-hook* to nil
    around the invocation.")
@@ -215,12 +265,17 @@ Functions/macros for your enjoyment:
 	((endp p))
       (format s "~&  ~D: ~A~%" i (car p)))))
 	 ;; Rebind some printer control variables.
-;;; INTERNAL-DEBUG calls the debug loop.  This is used in DEBUG and
-;;; CONDITIONS::ERROR-ERROR.
+	 (kernel:*current-level* 0)
 	 (*print-readably* nil)
+	 (*read-eval* t))
+    (format *error-output* "~2&~A~2&" *debug-condition*)
+    (unless (typep condition 'step-condition)
+      (show-restarts *debug-restarts* *error-output*))
+    (internal-debug)))
+
 ;;; SHOW-RESTARTS -- Internal.
-  (let ((*in-the-debugger* T)
-	(*read-suppress* NIL))
+;;;
+(defun show-restarts (restarts &optional (s *error-output*))
   (when restarts
     (format s "~&Restarts:~%")
     (let ((count 0)
@@ -241,13 +296,43 @@ Functions/macros for your enjoyment:
 				      (di:frame-code-location *current-frame*)
 		   (error "Unused rest-arg before n'th argument.")
 (defun debug-command-p (form)
-  (if (symbolp form)
-      (cdr (assoc (symbol-name form) *debug-commands* :test #'string=))))
+  (and (symbolp form)
+       (cdr (assoc (symbol-name form) *debug-commands* :test #'string=))))
 (defun debug-command-p (form &optional other-commands)
+      (let* ((name
+	  (mapc #'match-command other-commands))
+	;;
 	;; Return the right value.
+(def-debug-command "U"
+	      ((= (length res) 1)
+    (if next
+	(print-frame-call (setf *current-frame* next))
+	(princ "Top of stack."))))
+
+(def-debug-command "D"
+;;; Returns a list of debug commands (in the same format as *debug-commands*)
+    (if next
+	(print-frame-call (setf *current-frame* next))
+	(princ "Bottom of stack."))))
 (defun make-restart-commands (&optional (restarts *debug-restarts*))
+(def-debug-command "T"
+  (print-frame-call
+   (setf *current-frame*
+	 (do ((prev *current-frame* lead)
+	      (lead (di:frame-up *current-frame*) (di:frame-up lead)))
+	     ((null lead) prev)))))
+	    (push (cons (format nil "~d" num) restart-fun) commands))))
+(def-debug-command "B"
+  (print-frame-call
+   (setf *current-frame*
+	 (do ((prev *current-frame* lead)
+	      (lead (di:frame-down *current-frame*) (di:frame-down lead)))
+	     ((null lead) prev)))))
+
+
 (def-debug-command "FRAME" (&optional
-;;; 
+			    (n (read-prompting-maybe "Frame number: ")))
+  (let ((current (di:frame-number *current-frame*)))
 (def-debug-command "Q"
 	   (princ "You are here."))
 	  ((> n current)
@@ -259,6 +344,7 @@ Functions/macros for your enjoyment:
   (invoke-debugger *debug-condition*))
 
 (def-debug-command "ABORT"
+  ;; There's always at least one abort restart due to the top-level one.
   (invoke-restart *debug-abort*))
 		       (lead (di:frame-down *current-frame*)
 (def-debug-command "RESTART"
@@ -269,9 +355,10 @@ Functions/macros for your enjoyment:
 	  (t
     (invoke-restart-interactively (nth num *debug-restarts*))))
 ;;;
-
+;;; In and Out commands.
 ;;;
-;;; 
+
+(def-debug-command "QUIT" ()
 (def-debug-command "H"
   (princ debug-help-string))
 	  (princ "No such restart.")))))
@@ -279,15 +366,70 @@ Functions/macros for your enjoyment:
 ;;; Information commands.
 ;;;
  
-;;; BACKTRACE-DEBUG-COMMAND binds *inside-debugger-p*, so BACKTRACE will
-;;; not reparse the stack.  *inside-debugger-p* is only bound to non-nil
-;;; when doing evaluations in the debug loop.
-;;; 
 (def-debug-command "BACKTRACE"
-  (let ((*inside-debugger-p* t))
-    (backtrace (read-if-available most-positive-fixnum))))
+  "This controls how many lines the debugger's help command prints before
    printing a prompting line to continue with output.")
+(def-debug-command "P"
+(def-debug-command "HELP" ()
   (let* ((end -1)
+(def-debug-command "PP"
+  (print-frame-call *current-frame* nil nil))
+	    (count *help-line-scroll-count*))
+(def-debug-command "L"
+  (let ((*print-level* *debug-print-level*)
+	(*print-length* *debug-print-length*)
+	(*standard-output* *debug-io*)
+	(location (di:frame-code-location *current-frame*))
+	(any-p nil))
+    (di:do-debug-function-variables (v (di:frame-debug-function *current-frame*))
+      (setf any-p t)
+      (if (eq (di:debug-variable-validity v location) :valid)
+	  (format t "~A~:[#~D~;~*~]  =  ~S~%"
+		  (di:debug-variable-name v)
+		  (zerop (di:debug-variable-id v))
+		  (di:debug-variable-id v)
+		  (di:debug-variable-value v *current-frame*))
+	  #|(format t "~A has an invalid value currently.~%"
+		  (di:debug-variable-name v))|#))
+    (unless any-p (write-line "No variable information available."))))
+(def-debug-command-alias "PP" "VPRINT")
+(def-debug-command "SOURCE"
+  (let* ((location (di:frame-code-location *current-frame*))
+	      (format t "~A~:[#~D~;~*~]  =  ~S~%"
+		      (di:debug-variable-name v)
+    (cond ((not (eq :file (di:debug-source-from d-source)))
+	   (format t "~%Source did not come from a file."))
+	  ((not (probe-file name))
+	   (format t "~%Source file no longer exists -- ~A."
+		   (namestring name)))
+	  ((<= (di:debug-source-created d-source)
+	       (file-write-date name))
+	   (let* ((tlf-offset (di:code-location-top-level-form-offset
+			       location))
+		  (char-offset (aref (di:debug-source-start-positions
+				      d-source)
+				     tlf-offset))
+		  (context (read-if-available 0)))
+	     (with-open-file (f name)
+	       (file-position f char-offset)
+	       (let* ((tlf (read f))
+		      (translations (di:form-number-translations
+				     tlf tlf-offset))
+		      (*print-level* *debug-print-level*)
+		      (*print-length* *debug-print-length*))
+		 (print (di:source-path-context
+			 tlf
+			 (svref translations
+				(di:code-location-form-number location))
+			 context))))))
+	    (t
+	     (format t "~%File has been modified since compilation -- ~A."
+		     (namestring name))))))
+		  (setf *possible-breakpoints*
+			(possible-breakpoints
+			 *default-breakpoint-debug-function*))))))
+	   (setup-function-start ()
+
 (defvar *flush-debug-errors* t
   "Don't recursively call DEBUG on errors while within the debugger if non-nil.")
 	     (let ((code-loc (di:debug-function-start-location place)))
@@ -300,39 +442,45 @@ Functions/macros for your enjoyment:
 	  (format t "Note: previous breakpoint removed.~%"))
 	(push new-bp-info *breakpoints*))
       (print-breakpoint-info (first *breakpoints*))
-  (if (not (listen-skip-whitespace in))
+  (if (not (ext:listen-skip-whitespace in))
       (princ prompt out))
 
 ;;; list all breakpoints set
 (def-debug-command "LIST-BREAKPOINTS" ()
-  (if (listen-skip-whitespace stream)
+  (setf *breakpoints*
 	(sort *breakpoints* #'< :key #'breakpoint-info-breakpoint-number))
   (dolist (info *breakpoints*)
 
 
 
-;;;; Debug-Loop.
+;;;; DEBUG-LOOP.
 
 (defun debug-loop ()
-  (let ((*debug-command-level* (1+ *debug-command-level*)))
-    (loop
-     (catch 'debug-loop-catcher
-       (handler-bind ((error #'(lambda (condition)
-				 (when *flush-debug-errors*
-				   (clear-input *debug-io*)
-				   (princ condition)
-				   (format t "~&Error flushed ...")
-				   (throw 'debug-loop-catcher nil))
-				 (invoke-debugger condition))))
-	 (funcall *debug-prompt*)
-	 (let* ((exp (read))
-		(cmd-fun (debug-command-p exp))
-		;; Must bind level for restart function created for this abort.
-		(level *debug-command-level*))
-	   (with-simple-restart (abort "Return to debug level ~D." level)
-	     (if cmd-fun
-		 (funcall cmd-fun)
-		 (debug-eval-print exp)))))))))
+  (let ((*debug-command-level* (1+ *debug-command-level*))
+	(*current-frame* (di:top-frame)))
+    (handler-bind ((di:debug-condition #'(lambda (condition)
+					   (princ condition *debug-io*)
+					   (throw 'debug-loop-catcher nil))))
+      (print-frame-call *current-frame*)
+      (loop
+	(catch 'debug-loop-catcher
+	  (handler-bind ((error #'(lambda (condition)
+				    (when *flush-debug-errors*
+				      (clear-input *debug-io*)
+				      (princ condition)
+				      (format t "~&Error flushed ...")
+				      (throw 'debug-loop-catcher nil))
+				    (invoke-debugger condition))))
+	    (funcall *debug-prompt*)
+	    (let* ((exp (read))
+		   (cmd-fun (debug-command-p exp))
+		   ;; Must bind level for restart function created by
+		   ;; WITH-SIMPLE-RESTART.
+		   (level *debug-command-level*))
+	      (with-simple-restart (abort "Return to debug level ~D." level)
+		(if cmd-fun
+		    (funcall cmd-fun)
+		    (debug-eval-print exp))))))))))
 
 (defun debug-eval-print (exp)
   (setq +++ ++ ++ + + - - exp)