0.pre7.50:

[sbcl.git] / src / code / debug-int.lisp
diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp

index a4d95df..16eae71 100644 (file)
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -38,24 +38,26 @@
    ()
    #!+sb-doc
    (:documentation
    ()
    #!+sb-doc
    (:documentation
-   "All debug-conditions inherit from this type. These are serious conditions
+   "All DEBUG-CONDITIONs inherit from this type. These are serious conditions
      that must be handled, but they are not programmer errors."))
  
  (define-condition no-debug-info (debug-condition)
      that must be handled, but they are not programmer errors."))
  
  (define-condition no-debug-info (debug-condition)
-  ()
+  ((code-component :reader no-debug-info-code-component
+                  :initarg :code-component))
    #!+sb-doc
    #!+sb-doc
-  (:documentation "There is absolutely no debugging information available.")
+  (:documentation "There is no usable debugging information available.")
    (:report (lambda (condition stream)
    (:report (lambda (condition stream)
-            (declare (ignore condition))
              (fresh-line stream)
              (fresh-line stream)
-            (write-line "No debugging information available." stream))))
+            (format stream
+                    "no debug information available for ~S~%"
+                    (no-debug-info-code-component condition)))))
  
  (define-condition no-debug-function-returns (debug-condition)
    ((debug-function :reader no-debug-function-returns-debug-function
                    :initarg :debug-function))
    #!+sb-doc
    (:documentation
  
  (define-condition no-debug-function-returns (debug-condition)
    ((debug-function :reader no-debug-function-returns-debug-function
                    :initarg :debug-function))
    #!+sb-doc
    (:documentation
-   "The system could not return values from a frame with debug-function since
+   "The system could not return values from a frame with DEBUG-FUNCTION since
      it lacked information about returning values.")
    (:report (lambda (condition stream)
              (let ((fun (debug-function-function
      it lacked information about returning values.")
    (:report (lambda (condition stream)
              (let ((fun (debug-function-function
@@ -127,11 +129,11 @@
     "All programmer errors from using the interface for building debugging
      tools inherit from this type."))
  
     "All programmer errors from using the interface for building debugging
      tools inherit from this type."))
  
-(define-condition unhandled-condition (debug-error)
-  ((condition :reader unhandled-condition-condition :initarg :condition))
+(define-condition unhandled-debug-condition (debug-error)
+  ((condition :reader unhandled-debug-condition-condition :initarg :condition))
    (:report (lambda (condition stream)
              (format stream "~&unhandled DEBUG-CONDITION:~%~A"
    (:report (lambda (condition stream)
              (format stream "~&unhandled DEBUG-CONDITION:~%~A"
-                    (unhandled-condition-condition condition)))))
+                    (unhandled-debug-condition-condition condition)))))
  
  (define-condition unknown-code-location (debug-error)
    ((code-location :reader unknown-code-location-code-location
  
  (define-condition unknown-code-location (debug-error)
    ((code-location :reader unknown-code-location-code-location
@@ -162,20 +164,21 @@
     (frame :reader frame-function-mismatch-frame :initarg :frame)
     (form :reader frame-function-mismatch-form :initarg :form))
    (:report (lambda (condition stream)
     (frame :reader frame-function-mismatch-frame :initarg :frame)
     (form :reader frame-function-mismatch-form :initarg :form))
    (:report (lambda (condition stream)
-            (format stream
-                    "~&Form was preprocessed for ~S,~% but called on ~S:~%  ~S"
-                    (frame-function-mismatch-code-location condition)
-                    (frame-function-mismatch-frame condition)
-                    (frame-function-mismatch-form condition)))))
-
-;;; This signals debug-conditions. If they go unhandled, then signal an
-;;; unhandled-condition error.
+            (format
+             stream
+             "~&Form was preprocessed for ~S,~% but called on ~S:~%  ~S"
+             (frame-function-mismatch-code-location condition)
+             (frame-function-mismatch-frame condition)
+             (frame-function-mismatch-form condition)))))
+
+;;; This signals debug-conditions. If they go unhandled, then signal
+;;; an UNHANDLED-DEBUG-CONDITION error.
  ;;;
  ;;; ??? Get SIGNAL in the right package!
  (defmacro debug-signal (datum &rest arguments)
    `(let ((condition (make-condition ,datum ,@arguments)))
       (signal condition)
  ;;;
  ;;; ??? Get SIGNAL in the right package!
  (defmacro debug-signal (datum &rest arguments)
    `(let ((condition (make-condition ,datum ,@arguments)))
       (signal condition)
-     (error 'unhandled-condition :condition condition)))
+     (error 'unhandled-debug-condition :condition condition)))
  \f
  ;;;; structures
  ;;;;
  \f
  ;;;; structures
  ;;;;
@@ -183,13 +186,14 @@
  ;;;; data structures created by the compiler. Whenever comments
  ;;;; preface an object or type with "compiler", they refer to the
  ;;;; internal compiler thing, not to the object or type with the same
  ;;;; data structures created by the compiler. Whenever comments
  ;;;; preface an object or type with "compiler", they refer to the
  ;;;; internal compiler thing, not to the object or type with the same
-;;;; name in the "DI" package.
+;;;; name in the "SB-DI" package.
  
  ;;;; DEBUG-VARs
  
  ;;; These exist for caching data stored in packed binary form in
  ;;; compiler debug-functions. Debug-functions store these.
  
  ;;;; DEBUG-VARs
  
  ;;; These exist for caching data stored in packed binary form in
  ;;; compiler debug-functions. Debug-functions store these.
-(defstruct (debug-var (:constructor nil))
+(defstruct (debug-var (:constructor nil)
+                     (:copier nil))
    ;; the name of the variable
    (symbol (required-argument) :type symbol)
    ;; a unique integer identification relative to other variables with the same
    ;; the name of the variable
    (symbol (required-argument) :type symbol)
    ;; a unique integer identification relative to other variables with the same
@@ -206,28 +210,24 @@
  
  #!+sb-doc
  (setf (fdocumentation 'debug-var-id 'function)
  
  #!+sb-doc
  (setf (fdocumentation 'debug-var-id 'function)
-  "Returns the integer that makes DEBUG-VAR's name and package unique
+  "Return the integer that makes DEBUG-VAR's name and package unique
     with respect to other DEBUG-VARs in the same function.")
  
  (defstruct (compiled-debug-var
             (:include debug-var)
             (:constructor make-compiled-debug-var
     with respect to other DEBUG-VARs in the same function.")
  
  (defstruct (compiled-debug-var
             (:include debug-var)
             (:constructor make-compiled-debug-var
-                         (symbol id alive-p sc-offset save-sc-offset)))
+                         (symbol id alive-p sc-offset save-sc-offset))
+           (:copier nil))
    ;; Storage class and offset. (unexported).
    (sc-offset nil :type sb!c::sc-offset)
    ;; Storage class and offset when saved somewhere.
    (save-sc-offset nil :type (or sb!c::sc-offset null)))
  
    ;; Storage class and offset. (unexported).
    (sc-offset nil :type sb!c::sc-offset)
    ;; Storage class and offset when saved somewhere.
    (save-sc-offset nil :type (or sb!c::sc-offset null)))
  
-(defstruct (interpreted-debug-var
-           (:include debug-var (alive-p t))
-           (:constructor make-interpreted-debug-var (symbol ir1-var)))
-  ;; This is the IR1 structure that holds information about interpreted vars.
-  (ir1-var nil :type sb!c::lambda-var))
-
  ;;;; frames
  
  ;;; These represent call-frames on the stack.
  ;;;; frames
  
  ;;; These represent call-frames on the stack.
-(defstruct (frame (:constructor nil))
+(defstruct (frame (:constructor nil)
+                 (:copier nil))
    ;; the next frame up, or NIL when top frame
    (up nil :type (or frame null))
    ;; the previous frame down, or NIL when the bottom frame. Before
    ;; the next frame up, or NIL when top frame
    (up nil :type (or frame null))
    ;; the previous frame down, or NIL when the bottom frame. Before
@@ -242,25 +242,23 @@
    (code-location nil :type code-location)
    ;; an a-list of catch-tags to code-locations
    (%catches :unparsed :type (or list (member :unparsed)))
    (code-location nil :type code-location)
    ;; an a-list of catch-tags to code-locations
    (%catches :unparsed :type (or list (member :unparsed)))
-  ;; pointer to frame on control stack. (unexported) When this frame
-  ;; is an interpreted-frame, this pointer is an index into the
-  ;; interpreter's stack.
+  ;; pointer to frame on control stack (unexported)
    pointer
    ;; This is the frame's number for prompt printing. Top is zero.
    (number 0 :type index))
  
  #!+sb-doc
  (setf (fdocumentation 'frame-up 'function)
    pointer
    ;; This is the frame's number for prompt printing. Top is zero.
    (number 0 :type index))
  
  #!+sb-doc
  (setf (fdocumentation 'frame-up 'function)
-  "Returns the frame immediately above frame on the stack. When frame is
+  "Return the frame immediately above frame on the stack. When frame is
     the top of the stack, this returns nil.")
  
  #!+sb-doc
  (setf (fdocumentation 'frame-debug-function 'function)
     the top of the stack, this returns nil.")
  
  #!+sb-doc
  (setf (fdocumentation 'frame-debug-function 'function)
-  "Returns the debug-function for the function whose call frame represents.")
+  "Return the debug-function for the function whose call frame represents.")
  
  #!+sb-doc
  (setf (fdocumentation 'frame-code-location 'function)
  
  #!+sb-doc
  (setf (fdocumentation 'frame-code-location 'function)
-  "Returns the code-location where the frame's debug-function will continue
+  "Return the code-location where the frame's debug-function will continue
     running when program execution returns to this frame. If someone
     interrupted this frame, the result could be an unknown code-location.")
  
     running when program execution returns to this frame. If someone
     interrupted this frame, the result could be an unknown code-location.")
  
@@ -268,39 +266,20 @@
             (:include frame)
             (:constructor make-compiled-frame
                           (pointer up debug-function code-location number
             (:include frame)
             (:constructor make-compiled-frame
                           (pointer up debug-function code-location number
-                                  #!+gengc saved-state-chain
-                                  &optional escaped)))
+                                  &optional escaped))
+           (:copier nil))
    ;; This indicates whether someone interrupted the frame.
    ;; (unexported). If escaped, this is a pointer to the state that was
    ;; This indicates whether someone interrupted the frame.
    ;; (unexported). If escaped, this is a pointer to the state that was
-  ;; saved when we were interrupted. On the non-gengc system, this is
-  ;; a pointer to an os_context_t, i.e. the third argument to an
-  ;; SA_SIGACTION-style signal handler. On the gengc system, this is a
-  ;; state pointer from SAVED-STATE-CHAIN.
-  escaped
-  ;; a list of SAPs to saved states. Each time we unwind past an
-  ;; exception, we pop the next entry off this list. When we get to
-  ;; the end of the list, there is nothing else on the stack.
-  #!+gengc (saved-state-chain nil :type list))
+  ;; saved when we were interrupted, an os_context_t, i.e. the third
+  ;; argument to an SA_SIGACTION-style signal handler.
+  escaped)
  (def!method print-object ((obj compiled-frame) str)
    (print-unreadable-object (obj str :type t)
      (format str
             "~S~:[~;, interrupted~]"
             (debug-function-name (frame-debug-function obj))
             (compiled-frame-escaped obj))))
  (def!method print-object ((obj compiled-frame) str)
    (print-unreadable-object (obj str :type t)
      (format str
             "~S~:[~;, interrupted~]"
             (debug-function-name (frame-debug-function obj))
             (compiled-frame-escaped obj))))
-
-(defstruct (interpreted-frame
-           (:include frame)
-           (:constructor make-interpreted-frame
-                         (pointer up debug-function code-location number
-                          real-frame closure)))
-  ;; This points to the compiled-frame for SB!EVAL:INTERNAL-APPLY-LOOP.
-  (real-frame nil :type compiled-frame)
-  ;; This is the closed over data used by the interpreter.
-  (closure nil :type simple-vector))
-(def!method print-object ((obj interpreted-frame) str)
-  (print-unreadable-object (obj str :type t)
-    (prin1 (debug-function-name (frame-debug-function obj)) str)))
-
+\f
  ;;;; DEBUG-FUNCTIONs
  
  ;;; These exist for caching data stored in packed binary form in
  ;;;; DEBUG-FUNCTIONs
  
  ;;; These exist for caching data stored in packed binary form in
@@ -310,18 +289,19 @@
  ;;; code-locations and other objects that reference DEBUG-FUNCTIONs
  ;;; point to unique objects. This is due to the overhead in cached
  ;;; information.
  ;;; code-locations and other objects that reference DEBUG-FUNCTIONs
  ;;; point to unique objects. This is due to the overhead in cached
  ;;; information.
-(defstruct debug-function
-  ;; Some representation of the function arguments. See
+(defstruct (debug-function (:constructor nil)
+                          (:copier nil))
+  ;; some representation of the function arguments. See
    ;; DEBUG-FUNCTION-LAMBDA-LIST.
    ;; NOTE: must parse vars before parsing arg list stuff.
    (%lambda-list :unparsed)
    ;; DEBUG-FUNCTION-LAMBDA-LIST.
    ;; NOTE: must parse vars before parsing arg list stuff.
    (%lambda-list :unparsed)
-  ;; Cached DEBUG-VARS information. (unexported).
+  ;; cached DEBUG-VARS information (unexported).
    ;; These are sorted by their name.
    (%debug-vars :unparsed :type (or simple-vector null (member :unparsed)))
    ;; These are sorted by their name.
    (%debug-vars :unparsed :type (or simple-vector null (member :unparsed)))
-  ;; Cached debug-block information. This is NIL when we have tried to
+  ;; cached debug-block information. This is NIL when we have tried to
    ;; parse the packed binary info, but none is available.
    (blocks :unparsed :type (or simple-vector null (member :unparsed)))
    ;; parse the packed binary info, but none is available.
    (blocks :unparsed :type (or simple-vector null (member :unparsed)))
-  ;; The actual function if available.
+  ;; the actual function if available
    (%function :unparsed :type (or null function (member :unparsed))))
  (def!method print-object ((obj debug-function) stream)
    (print-unreadable-object (obj stream :type t)
    (%function :unparsed :type (or null function (member :unparsed))))
  (def!method print-object ((obj debug-function) stream)
    (print-unreadable-object (obj stream :type t)
@@ -330,13 +310,14 @@
  (defstruct (compiled-debug-function
             (:include debug-function)
             (:constructor %make-compiled-debug-function
  (defstruct (compiled-debug-function
             (:include debug-function)
             (:constructor %make-compiled-debug-function
-                         (compiler-debug-fun component)))
-  ;; Compiler's dumped debug-function information. (unexported).
+                         (compiler-debug-fun component))
+           (:copier nil))
+  ;; compiler's dumped debug-function information (unexported)
    (compiler-debug-fun nil :type sb!c::compiled-debug-function)
    (compiler-debug-fun nil :type sb!c::compiled-debug-function)
-  ;; Code object. (unexported).
+  ;; code object (unexported).
    component
    component
-  ;; The :FUNCTION-START breakpoint (if any) used to facilitate
-  ;; function end breakpoints.
+  ;; the :FUNCTION-START breakpoint (if any) used to facilitate
+  ;; function end breakpoints
    (end-starter nil :type (or null breakpoint)))
  
  ;;; This maps SB!C::COMPILED-DEBUG-FUNCTIONs to
    (end-starter nil :type (or null breakpoint)))
  
  ;;; This maps SB!C::COMPILED-DEBUG-FUNCTIONs to
@@ -354,39 +335,28 @@
        (setf (gethash compiler-debug-fun *compiled-debug-functions*)
             (%make-compiled-debug-function compiler-debug-fun component))))
  
        (setf (gethash compiler-debug-fun *compiled-debug-functions*)
             (%make-compiled-debug-function compiler-debug-fun component))))
  
-(defstruct (interpreted-debug-function
-           (:include debug-function)
-           (:constructor %make-interpreted-debug-function (ir1-lambda)))
-  ;; This is the IR1 lambda that this debug-function represents.
-  (ir1-lambda nil :type sb!c::clambda))
-
  (defstruct (bogus-debug-function
             (:include debug-function)
             (:constructor make-bogus-debug-function
                           (%name &aux (%lambda-list nil) (%debug-vars nil)
  (defstruct (bogus-debug-function
             (:include debug-function)
             (:constructor make-bogus-debug-function
                           (%name &aux (%lambda-list nil) (%debug-vars nil)
-                                (blocks nil) (%function nil))))
+                                (blocks nil) (%function nil)))
+           (:copier nil))
    %name)
  
  (defvar *ir1-lambda-debug-function* (make-hash-table :test 'eq))
    %name)
  
  (defvar *ir1-lambda-debug-function* (make-hash-table :test 'eq))
-
-(defun make-interpreted-debug-function (ir1-lambda)
-  (let ((home-lambda (sb!c::lambda-home ir1-lambda)))
-    (or (gethash home-lambda *ir1-lambda-debug-function*)
-       (setf (gethash home-lambda *ir1-lambda-debug-function*)
-             (%make-interpreted-debug-function home-lambda)))))
-
+\f
  ;;;; DEBUG-BLOCKs
  
  ;;; These exist for caching data stored in packed binary form in compiler
  ;;;; DEBUG-BLOCKs
  
  ;;; These exist for caching data stored in packed binary form in compiler
-;;; debug-blocks.
-(defstruct (debug-block (:constructor nil))
+;;; DEBUG-BLOCKs.
+(defstruct (debug-block (:constructor nil)
+                       (:copier nil))
    ;; Code-locations where execution continues after this block.
    (successors nil :type list)
    ;; Code-locations where execution continues after this block.
    (successors nil :type list)
-  ;; This indicates whether the block is a special glob of code shared by
-  ;; various functions and tucked away elsewhere in a component. This kind of
-  ;; block has no start code-location. In an interpreted-debug-block, this is
-  ;; always nil. This slot is in all debug-blocks since it is an exported
-  ;; interface.
+  ;; This indicates whether the block is a special glob of code shared
+  ;; by various functions and tucked away elsewhere in a component.
+  ;; This kind of block has no start code-location. This slot is in
+  ;; all debug-blocks since it is an exported interface.
    (elsewhere-p nil :type boolean))
  (def!method print-object ((obj debug-block) str)
    (print-unreadable-object (obj str :type t)
    (elsewhere-p nil :type boolean))
  (def!method print-object ((obj debug-block) str)
    (print-unreadable-object (obj str :type t)
@@ -394,75 +364,30 @@
  
  #!+sb-doc
  (setf (fdocumentation 'debug-block-successors 'function)
  
  #!+sb-doc
  (setf (fdocumentation 'debug-block-successors 'function)
-  "Returns the list of possible code-locations where execution may continue
+  "Return the list of possible code-locations where execution may continue
     when the basic-block represented by debug-block completes its execution.")
  
  #!+sb-doc
  (setf (fdocumentation 'debug-block-elsewhere-p 'function)
     when the basic-block represented by debug-block completes its execution.")
  
  #!+sb-doc
  (setf (fdocumentation 'debug-block-elsewhere-p 'function)
-  "Returns whether debug-block represents elsewhere code.")
+  "Return whether debug-block represents elsewhere code.")
  
  (defstruct (compiled-debug-block (:include debug-block)
                                  (:constructor
                                   make-compiled-debug-block
  
  (defstruct (compiled-debug-block (:include debug-block)
                                  (:constructor
                                   make-compiled-debug-block
-                                 (code-locations successors elsewhere-p)))
-  ;; Code-location information for the block.
+                                 (code-locations successors elsewhere-p))
+                                (:copier nil))
+  ;; code-location information for the block
    (code-locations nil :type simple-vector))
  
    (code-locations nil :type simple-vector))
  
-(defstruct (interpreted-debug-block (:include debug-block
-                                             (elsewhere-p nil))
-                                   (:constructor %make-interpreted-debug-block
-                                                 (ir1-block)))
-  ;; This is the IR1 block this debug-block represents.
-  (ir1-block nil :type sb!c::cblock)
-  ;; Code-location information for the block.
-  (locations :unparsed :type (or (member :unparsed) simple-vector)))
-
  (defvar *ir1-block-debug-block* (make-hash-table :test 'eq))
  (defvar *ir1-block-debug-block* (make-hash-table :test 'eq))
-
-;;; Make a DEBUG-BLOCK for the interpreter's IR1-BLOCK. If we have it
-;;; in the cache, return it. If we need to make it, then first make
-;;; DEBUG-BLOCKs for all the IR1-BLOCKs in IR1-BLOCK's home lambda;
-;;; this makes sure all the successors of IR1-BLOCK have DEBUG-BLOCKs.
-;;; We need this to fill in the resulting DEBUG-BLOCK's successors
-;;; list with DEBUG-BLOCKs, not IR1-BLOCKs. After making all the
-;;; possible DEBUG-BLOCKs we'll need to reference, go back over the
-;;; list of new DEBUG-BLOCKs and fill in their successor slots with
-;;; lists of DEBUG-BLOCKs. Then look up our argument IR1-BLOCK to find
-;;; its DEBUG-BLOCK since we know we have it now.
-(defun make-interpreted-debug-block (ir1-block)
-  (check-type ir1-block sb!c::cblock)
-  (let ((res (gethash ir1-block *ir1-block-debug-block*)))
-    (or res
-       (let ((lambda (sb!c::block-home-lambda ir1-block)))
-         (sb!c::do-blocks (block (sb!c::block-component ir1-block))
-           (when (eq lambda (sb!c::block-home-lambda block))
-             (push (setf (gethash block *ir1-block-debug-block*)
-                         (%make-interpreted-debug-block block))
-                   res)))
-         (dolist (block res)
-           (let* ((successors nil)
-                  (cblock (interpreted-debug-block-ir1-block block))
-                  (succ (sb!c::block-succ cblock))
-                  (valid-succ
-                   (if (and succ
-                            (eq (car succ)
-                                (sb!c::component-tail
-                                 (sb!c::block-component cblock))))
-                       ()
-                       succ)))
-             (dolist (sblock valid-succ)
-               (let ((dblock (gethash sblock *ir1-block-debug-block*)))
-                 (when dblock
-                   (push dblock successors))))
-             (setf (debug-block-successors block) (nreverse successors))))
-         (gethash ir1-block *ir1-block-debug-block*)))))
-
+\f
  ;;;; breakpoints
  
  ;;; This is an internal structure that manages information about a
  ;;; breakpoint locations. See *COMPONENT-BREAKPOINT-OFFSETS*.
  (defstruct (breakpoint-data (:constructor make-breakpoint-data
  ;;;; breakpoints
  
  ;;; This is an internal structure that manages information about a
  ;;; breakpoint locations. See *COMPONENT-BREAKPOINT-OFFSETS*.
  (defstruct (breakpoint-data (:constructor make-breakpoint-data
-                                         (component offset)))
+                                         (component offset))
+                           (:copier nil))
    ;; This is the component in which the breakpoint lies.
    component
    ;; This is the byte offset into the component.
    ;; This is the component in which the breakpoint lies.
    component
    ;; This is the byte offset into the component.
@@ -480,7 +405,8 @@
             (breakpoint-data-offset obj))))
  
  (defstruct (breakpoint (:constructor %make-breakpoint
             (breakpoint-data-offset obj))))
  
  (defstruct (breakpoint (:constructor %make-breakpoint
-                                    (hook-function what kind %info)))
+                                    (hook-function what kind %info))
+                      (:copier nil))
    ;; This is the function invoked when execution encounters the
    ;; breakpoint. It takes a frame, the breakpoint, and optionally a
    ;; list of values. Values are supplied for :FUNCTION-END breakpoints
    ;; This is the function invoked when execution encounters the
    ;; breakpoint. It takes a frame, the breakpoint, and optionally a
    ;; list of values. Values are supplied for :FUNCTION-END breakpoints
@@ -531,23 +457,11 @@
               (etypecase what
                 (code-location nil)
                 (debug-function (breakpoint-kind obj)))))))
               (etypecase what
                 (code-location nil)
                 (debug-function (breakpoint-kind obj)))))))
-
-#!+sb-doc
-(setf (fdocumentation 'breakpoint-hook-function 'function)
-  "Returns the breakpoint's function the system calls when execution encounters
-   the breakpoint, and it is active. This is SETF'able.")
-
-#!+sb-doc
-(setf (fdocumentation 'breakpoint-what 'function)
-  "Returns the breakpoint's what specification.")
-
-#!+sb-doc
-(setf (fdocumentation 'breakpoint-kind 'function)
-  "Returns the breakpoint's kind specification.")
-
+\f
  ;;;; CODE-LOCATIONs
  
  ;;;; CODE-LOCATIONs
  
-(defstruct (code-location (:constructor nil))
+(defstruct (code-location (:constructor nil)
+                         (:copier nil))
    ;; This is the debug-function containing code-location.
    (debug-function nil :type debug-function)
    ;; This is initially :UNSURE. Upon first trying to access an
    ;; This is the debug-function containing code-location.
    (debug-function nil :type debug-function)
    ;; This is initially :UNSURE. Upon first trying to access an
@@ -573,17 +487,13 @@
      (prin1 (debug-function-name (code-location-debug-function obj))
            str)))
  
      (prin1 (debug-function-name (code-location-debug-function obj))
            str)))
  
-#!+sb-doc
-(setf (fdocumentation 'code-location-debug-function 'function)
-  "Returns the debug-function representing information about the function
-   corresponding to the code-location.")
-
  (defstruct (compiled-code-location
             (:include code-location)
             (:constructor make-known-code-location
                           (pc debug-function %tlf-offset %form-number
                               %live-set kind &aux (%unknown-p nil)))
  (defstruct (compiled-code-location
             (:include code-location)
             (:constructor make-known-code-location
                           (pc debug-function %tlf-offset %form-number
                               %live-set kind &aux (%unknown-p nil)))
-           (:constructor make-compiled-code-location (pc debug-function)))
+           (:constructor make-compiled-code-location (pc debug-function))
+           (:copier nil))
    ;; This is an index into debug-function's component slot.
    (pc nil :type sb!c::index)
    ;; This is a bit-vector indexed by a variable's position in
    ;; This is an index into debug-function's component slot.
    (pc nil :type sb!c::index)
    ;; This is a bit-vector indexed by a variable's position in
@@ -593,64 +503,21 @@
    ;; (unexported) To see SB!C::LOCATION-KIND, do
    ;; (SB!KERNEL:TYPE-EXPAND 'SB!C::LOCATION-KIND).
    (kind :unparsed :type (or (member :unparsed) sb!c::location-kind)))
    ;; (unexported) To see SB!C::LOCATION-KIND, do
    ;; (SB!KERNEL:TYPE-EXPAND 'SB!C::LOCATION-KIND).
    (kind :unparsed :type (or (member :unparsed) sb!c::location-kind)))
-
-(defstruct (interpreted-code-location
-           (:include code-location
-                     (%unknown-p nil))
-           (:constructor make-interpreted-code-location
-                         (ir1-node debug-function)))
-  ;; This is an index into debug-function's component slot.
-  (ir1-node nil :type sb!c::node))
-
-;;; DEBUG-SOURCEs
-
-#!-sb-fluid (declaim (inline debug-source-root-number))
+\f
+;;;; DEBUG-SOURCEs
+
+;;; Return the number of top-level forms processed by the compiler
+;;; before compiling this source. If this source is uncompiled, this
+;;; is zero. This may be zero even if the source is compiled since the
+;;; first form in the first file compiled in one compilation, for
+;;; example, must have a root number of zero -- the compiler saw no
+;;; other top-level forms before it.
  (defun debug-source-root-number (debug-source)
  (defun debug-source-root-number (debug-source)
-  #!+sb-doc
-  "Returns the number of top-level forms processed by the compiler before
-   compiling this source. If this source is uncompiled, this is zero. This
-   may be zero even if the source is compiled since the first form in the first
-   file compiled in one compilation, for example, must have a root number of
-   zero -- the compiler saw no other top-level forms before it."
    (sb!c::debug-source-source-root debug-source))
    (sb!c::debug-source-source-root debug-source))
-
-#!+sb-doc
-(setf (fdocumentation 'sb!c::debug-source-from 'function)
-  "Returns an indication of the type of source. The following are the possible
-   values:
-      :file    from a file (obtained by COMPILE-FILE if compiled).
-      :lisp    from Lisp (obtained by COMPILE if compiled).")
-
-#!+sb-doc
-(setf (fdocumentation 'sb!c::debug-source-name 'function)
-  "Returns the actual source in some sense represented by debug-source, which
-   is related to DEBUG-SOURCE-FROM:
-      :file    the pathname of the file.
-      :lisp    a lambda-expression.")
-
-#!+sb-doc
-(setf (fdocumentation 'sb!c::debug-source-created 'function)
-  "Returns the universal time someone created the source. This may be nil if
-   it is unavailable.")
-
-#!+sb-doc
-(setf (fdocumentation 'sb!c::debug-source-compiled 'function)
-  "Returns the time someone compiled the source. This is nil if the source
-   is uncompiled.")
-
-#!+sb-doc
-(setf (fdocumentation 'sb!c::debug-source-start-positions 'function)
-  "This function returns the file position of each top-level form as an array
-   if debug-source is from a :file. If DEBUG-SOURCE-FROM is :lisp,
-   this returns nil.")
-
-#!+sb-doc
-(setf (fdocumentation 'sb!c::debug-source-p 'function)
-  "Returns whether object is a debug-source.")
  \f
  ;;;; frames
  
  \f
  ;;;; frames
  
-;;; This is used in FIND-ESCAPE-FRAME and with the bogus components
+;;; This is used in FIND-ESCAPED-FRAME and with the bogus components
  ;;; and LRAs used for :function-end breakpoints. When a components
  ;;; debug-info slot is :bogus-lra, then the real-lra-slot contains the
  ;;; real component to continue executing, as opposed to the bogus
  ;;; and LRAs used for :function-end breakpoints. When a components
  ;;; debug-info slot is :bogus-lra, then the real-lra-slot contains the
  ;;; real component to continue executing, as opposed to the bogus
@@ -663,7 +530,7 @@
  (defun stack-ref (s n) (stack-ref s n))
  (defun %set-stack-ref (s n value) (%set-stack-ref s n value))
  (defun function-code-header (fun) (function-code-header fun))
  (defun stack-ref (s n) (stack-ref s n))
  (defun %set-stack-ref (s n value) (%set-stack-ref s n value))
  (defun function-code-header (fun) (function-code-header fun))
-#!-gengc (defun lra-code-header (lra) (lra-code-header lra))
+(defun lra-code-header (lra) (lra-code-header lra))
  (defun make-lisp-obj (value) (make-lisp-obj value))
  (defun get-lisp-obj-address (thing) (get-lisp-obj-address thing))
  (defun function-word-offset (fun) (function-word-offset fun))
  (defun make-lisp-obj (value) (make-lisp-obj value))
  (defun get-lisp-obj-address (thing) (get-lisp-obj-address thing))
  (defun function-word-offset (fun) (function-word-offset fun))
@@ -673,8 +540,7 @@
    (declare (type system-area-pointer x))
    #!-x86 ; stack grows toward high address values
    (and (sap< x (current-sp))
    (declare (type system-area-pointer x))
    #!-x86 ; stack grows toward high address values
    (and (sap< x (current-sp))
-       (sap<= #!-gengc (int-sap control-stack-start)
-             #!+gengc (mutator-control-stack-base)
+       (sap<= (int-sap control-stack-start)
               x)
         (zerop (logand (sap-int x) #b11)))
    #!+x86 ; stack grows toward low address values
               x)
         (zerop (logand (sap-int x) #b11)))
    #!+x86 ; stack grows toward low address values
@@ -682,11 +548,11 @@
         (sap> (int-sap control-stack-end) x)
         (zerop (logand (sap-int x) #b11))))
  
         (sap> (int-sap control-stack-end) x)
         (zerop (logand (sap-int x) #b11))))
  
-#!+(or gengc x86)
+#!+x86
  (sb!alien:def-alien-routine component-ptr-from-pc (system-area-pointer)
    (pc system-area-pointer))
  
  (sb!alien:def-alien-routine component-ptr-from-pc (system-area-pointer)
    (pc system-area-pointer))
  
-#!+(or gengc x86)
+#!+x86
  (defun component-from-component-ptr (component-ptr)
    (declare (type system-area-pointer component-ptr))
    (make-lisp-obj (logior (sap-int component-ptr)
  (defun component-from-component-ptr (component-ptr)
    (declare (type system-area-pointer component-ptr))
    (make-lisp-obj (logior (sap-int component-ptr)
@@ -732,9 +598,9 @@
  ;;; XXX Should probably check whether it has reached the bottom of the
  ;;; stack.
  ;;;
  ;;; XXX Should probably check whether it has reached the bottom of the
  ;;; stack.
  ;;;
-;;; XXX Should handle interrupted frames, both Lisp and C. At present it
-;;; manages to find a fp trail, see linux hack below.
-(defun x86-call-context (fp &key (depth 8))
+;;; XXX Should handle interrupted frames, both Lisp and C. At present
+;;; it manages to find a fp trail, see linux hack below.
+(defun x86-call-context (fp &key (depth 0))
    (declare (type system-area-pointer fp)
            (fixnum depth))
    ;;(format t "*CC ~S ~S~%" fp depth)
    (declare (type system-area-pointer fp)
            (fixnum depth))
    ;;(format t "*CC ~S ~S~%" fp depth)
@@ -758,15 +624,20 @@
                            lisp-ocfp lisp-ra c-ocfp c-ra)
              ;; Look forward another step to check their validity.
              (let ((lisp-path-fp (x86-call-context lisp-ocfp
                            lisp-ocfp lisp-ra c-ocfp c-ra)
              ;; Look forward another step to check their validity.
              (let ((lisp-path-fp (x86-call-context lisp-ocfp
-                                                  :depth (- depth 1)))
-                  (c-path-fp (x86-call-context c-ocfp :depth (- depth 1))))
+                                                  :depth (1+ depth)))
+                  (c-path-fp (x86-call-context c-ocfp :depth (1+ depth))))
                (cond ((and lisp-path-fp c-path-fp)
                (cond ((and lisp-path-fp c-path-fp)
-                     ;; Both still seem valid - choose the smallest.
-                     #+nil (format t "debug: both still valid ~S ~S ~S ~S~%"
-                                   lisp-ocfp lisp-ra c-ocfp c-ra)
-                     (if (sap< lisp-ocfp c-ocfp)
-                         (values lisp-ra lisp-ocfp)
-                       (values c-ra c-ocfp)))
+                       ;; Both still seem valid - choose the lisp frame.
+                       #+nil (when (zerop depth)
+                               (format t
+                                      "debug: both still valid ~S ~S ~S ~S~%"
+                                       lisp-ocfp lisp-ra c-ocfp c-ra))
+                     #+freebsd
+                     (if (sap> lisp-ocfp c-ocfp)
+                        (values lisp-ra lisp-ocfp)
+                       (values c-ra c-ocfp))
+                       #-freebsd
+                       (values lisp-ra lisp-ocfp))
                      (lisp-path-fp
                       ;; The lisp convention is looking good.
                       #+nil (format t "*C lisp-ocfp ~S ~S~%" lisp-ocfp lisp-ra)
                      (lisp-path-fp
                       ;; The lisp convention is looking good.
                       #+nil (format t "*C lisp-ocfp ~S ~S~%" lisp-ocfp lisp-ra)
@@ -803,61 +674,48 @@
  (defun descriptor-sap (x)
    (int-sap (get-lisp-obj-address x)))
  
  (defun descriptor-sap (x)
    (int-sap (get-lisp-obj-address x)))
  
+;;; Return the top frame of the control stack as it was before calling
+;;; this function.
  (defun top-frame ()
  (defun top-frame ()
-  #!+sb-doc
-  "Returns the top frame of the control stack as it was before calling this
-   function."
+  (/show0 "entering TOP-FRAME")
    (multiple-value-bind (fp pc) (%caller-frame-and-pc)
    (multiple-value-bind (fp pc) (%caller-frame-and-pc)
-    (possibly-an-interpreted-frame
-     (compute-calling-frame (descriptor-sap fp)
-                           #!-gengc pc #!+gengc (descriptor-sap pc)
-                           nil)
-     nil)))
+    (compute-calling-frame (descriptor-sap fp) pc nil)))
  
  
+;;; Flush all of the frames above FRAME, and renumber all the frames
+;;; below FRAME.
  (defun flush-frames-above (frame)
  (defun flush-frames-above (frame)
-  #!+sb-doc
-  "Flush all of the frames above FRAME, and renumber all the frames below
-   FRAME."
    (setf (frame-up frame) nil)
    (do ((number 0 (1+ number))
         (frame frame (frame-%down frame)))
        ((not (frame-p frame)))
      (setf (frame-number frame) number)))
  
    (setf (frame-up frame) nil)
    (do ((number 0 (1+ number))
         (frame frame (frame-%down frame)))
        ((not (frame-p frame)))
      (setf (frame-number frame) number)))
  
-;;; We have to access the old-fp and return-pc out of frame and pass them to
-;;; COMPUTE-CALLING-FRAME.
+;;; Return the frame immediately below FRAME on the stack; or when
+;;; FRAME is the bottom of the stack, return NIL.
  (defun frame-down (frame)
  (defun frame-down (frame)
-  #!+sb-doc
-  "Returns the frame immediately below frame on the stack. When frame is
-   the bottom of the stack, this returns nil."
+  (/show0 "entering FRAME-DOWN")
+  ;; We have to access the old-fp and return-pc out of frame and pass
+  ;; them to COMPUTE-CALLING-FRAME.
    (let ((down (frame-%down frame)))
      (if (eq down :unparsed)
    (let ((down (frame-%down frame)))
      (if (eq down :unparsed)
-       (let* ((real (frame-real-frame frame))
-              (debug-fun (frame-debug-function real)))
+       (let ((debug-fun (frame-debug-function frame)))
+         (/show0 "in DOWN :UNPARSED case")
           (setf (frame-%down frame)
                 (etypecase debug-fun
                   (compiled-debug-function
                    (let ((c-d-f (compiled-debug-function-compiler-debug-fun
                                  debug-fun)))
           (setf (frame-%down frame)
                 (etypecase debug-fun
                   (compiled-debug-function
                    (let ((c-d-f (compiled-debug-function-compiler-debug-fun
                                  debug-fun)))
-                    (possibly-an-interpreted-frame
-                     (compute-calling-frame
-                      (descriptor-sap
-                       (get-context-value
-                        real sb!vm::ocfp-save-offset
-                        (sb!c::compiled-debug-function-old-fp c-d-f)))
-                      #!-gengc
+                    (compute-calling-frame
+                     (descriptor-sap
                        (get-context-value
                        (get-context-value
-                       real sb!vm::lra-save-offset
-                       (sb!c::compiled-debug-function-return-pc c-d-f))
-                      #!+gengc
-                      (descriptor-sap
-                       (get-context-value
-                        real sb!vm::ra-save-offset
-                        (sb!c::compiled-debug-function-return-pc c-d-f)))
-                      frame)
+                       frame sb!vm::ocfp-save-offset
+                       (sb!c::compiled-debug-function-old-fp c-d-f)))
+                     (get-context-value
+                      frame sb!vm::lra-save-offset
+                      (sb!c::compiled-debug-function-return-pc c-d-f))
                       frame)))
                   (bogus-debug-function
                       frame)))
                   (bogus-debug-function
-                  (let ((fp (frame-pointer real)))
+                  (let ((fp (frame-pointer frame)))
                      (when (cstack-pointer-valid-p fp)
                        #!+x86
                         (multiple-value-bind (ra ofp) (x86-call-context fp)
                      (when (cstack-pointer-valid-p fp)
                        #!+x86
                         (multiple-value-bind (ra ofp) (x86-call-context fp)
@@ -872,11 +730,8 @@
                          (sap-ref-32 fp (* sb!vm::ocfp-save-offset
                                            sb!vm:word-bytes)))
  
                          (sap-ref-32 fp (* sb!vm::ocfp-save-offset
                                            sb!vm:word-bytes)))
  
-                       #!-gengc
                         (stack-ref fp sb!vm::lra-save-offset)
                         (stack-ref fp sb!vm::lra-save-offset)
-                       #!+gengc
-                       (sap-ref-sap fp (* sb!vm::ra-save-offset
-                                          sb!vm:word-bytes))
+
                         frame)))))))
         down)))
  
                         frame)))))))
         down)))
  
@@ -930,52 +785,6 @@
           (#.sb!vm::lra-save-offset
            (setf (sap-ref-sap pointer (- (* (1+ stack-slot) 4))) value))))))
  
           (#.sb!vm::lra-save-offset
            (setf (sap-ref-sap pointer (- (* (1+ stack-slot) 4))) value))))))
  
-(defvar *debugging-interpreter* nil
-  #!+sb-doc
-  "When set, the debugger foregoes making interpreted-frames, so you can
-   debug the functions that manifest the interpreter.")
-
-;;; This takes a newly computed frame, FRAME, and the frame above it
-;;; on the stack, UP-FRAME, which is possibly NIL. FRAME is NIL when
-;;; we hit the bottom of the control stack. When FRAME represents a
-;;; call to SB!EVAL::INTERNAL-APPLY-LOOP, we make an interpreted frame
-;;; to replace FRAME. The interpreted frame points to FRAME.
-(defun possibly-an-interpreted-frame (frame up-frame)
-  (if (or (not frame)
-         (not (eq (debug-function-name (frame-debug-function frame))
-                  'sb!eval::internal-apply-loop))
-         *debugging-interpreter*
-         (compiled-frame-escaped frame))
-      frame
-      (flet ((get-var (name location)
-              (let ((vars (sb!di:ambiguous-debug-vars
-                           (sb!di:frame-debug-function frame) name)))
-                (when (or (null vars) (> (length vars) 1))
-                  (error "zero or more than one ~A variable in ~
-                          SB!EVAL::INTERNAL-APPLY-LOOP"
-                         (string-downcase name)))
-                (if (eq (debug-var-validity (car vars) location)
-                        :valid)
-                    (car vars)))))
-       (let* ((code-loc (frame-code-location frame))
-              (ptr-var (get-var "FRAME-PTR" code-loc))
-              (node-var (get-var "NODE" code-loc))
-              (closure-var (get-var "CLOSURE" code-loc)))
-         (if (and ptr-var node-var closure-var)
-             (let* ((node (debug-var-value node-var frame))
-                    (d-fun (make-interpreted-debug-function
-                            (sb!c::block-home-lambda (sb!c::node-block
-                                                      node)))))
-               (make-interpreted-frame
-                (debug-var-value ptr-var frame)
-                up-frame
-                d-fun
-                (make-interpreted-code-location node d-fun)
-                (frame-number frame)
-                frame
-                (debug-var-value closure-var frame)))
-             frame)))))
-
  ;;; This returns a frame for the one existing in time immediately
  ;;; prior to the frame referenced by current-fp. This is current-fp's
  ;;; caller or the next frame down the control stack. If there is no
  ;;; This returns a frame for the one existing in time immediately
  ;;; prior to the frame referenced by current-fp. This is current-fp's
  ;;; caller or the next frame down the control stack. If there is no
@@ -990,7 +799,7 @@
  ;;; Note: Sometimes LRA is actually a fixnum. This happens when lisp
  ;;; calls into C. In this case, the code object is stored on the stack
  ;;; after the LRA, and the LRA is the word offset.
  ;;; Note: Sometimes LRA is actually a fixnum. This happens when lisp
  ;;; calls into C. In this case, the code object is stored on the stack
  ;;; after the LRA, and the LRA is the word offset.
-#!-(or gengc x86)
+#!-x86
  (defun compute-calling-frame (caller lra up-frame)
    (declare (type system-area-pointer caller))
    (when (cstack-pointer-valid-p caller)
  (defun compute-calling-frame (caller lra up-frame)
    (declare (type system-area-pointer caller))
    (when (cstack-pointer-valid-p caller)
@@ -1037,80 +846,70 @@
  #!+x86
  (defun compute-calling-frame (caller ra up-frame)
    (declare (type system-area-pointer caller ra))
  #!+x86
  (defun compute-calling-frame (caller ra up-frame)
    (declare (type system-area-pointer caller ra))
-;  (format t "ccf: ~A ~A ~A~%" caller ra up-frame)
+  (/show0 "entering COMPUTE-CALLING-FRAME")
    (when (cstack-pointer-valid-p caller)
    (when (cstack-pointer-valid-p caller)
-;    (format t "ccf2~%")
+    (/show0 "in WHEN")
      ;; First check for an escaped frame.
      (multiple-value-bind (code pc-offset escaped) (find-escaped-frame caller)
      ;; First check for an escaped frame.
      (multiple-value-bind (code pc-offset escaped) (find-escaped-frame caller)
-       (cond (code
-              ;; If it's escaped it may be a function end breakpoint trap.
-;             (format t "ccf2: escaped ~S ~S~%" code pc-offset)
-              (when (and (code-component-p code)
-                         (eq (%code-debug-info code) :bogus-lra))
-                ;; If :bogus-lra grab the real lra.
-                (setq pc-offset (code-header-ref
-                                 code (1+ real-lra-slot)))
-                (setq code (code-header-ref code real-lra-slot))
-;               (format t "ccf3 :bogus-lra ~S ~S~%" code pc-offset)
-                (assert code)))
-             (t
-              ;; Not escaped
-              (multiple-value-setq (pc-offset code)
-                (compute-lra-data-from-pc ra))
-;             (format t "ccf4 ~S ~S~%" code pc-offset)
-              (unless code
-                (setf code :foreign-function
-                      pc-offset 0
-                      escaped nil))))
-
-       (let ((d-fun (case code
-                          (:undefined-function
-                           (make-bogus-debug-function
-                            "undefined function"))
-                          (:foreign-function
-                           (make-bogus-debug-function
-                            "foreign function call land"))
-                          ((nil)
-                           (make-bogus-debug-function
-                            "bogus stack frame"))
-                          (t
-                           (debug-function-from-pc code pc-offset)))))
-         (make-compiled-frame caller up-frame d-fun
-                              (code-location-from-pc d-fun pc-offset
-                                                     escaped)
-                              (if up-frame (1+ (frame-number up-frame)) 0)
-                              escaped)))))
-
-#!-(or gengc x86)
-;;; FIXME: The original CMU CL code had support for this case, but it
-;;; must have been fairly stale even in CMU CL, since it had
-;;; references to the MIPS package, and there have been enough
-;;; relevant changes in SBCL (particularly using
-;;; POSIX/SIGACTION0-style signal context instead of BSD-style
-;;; sigcontext) that this code is unmaintainable (since as of
-;;; sbcl-0.6.7, and for the foreseeable future, we can't test it,
-;;; since we only support X86 and its gencgc).
-;;;
-;;; If we restore this case, the best approach would be to go back to
-;;; the original CMU CL code and start from there.
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (error "hopelessly stale"))
+      (/show0 "at COND")
+      (cond (code
+            (/show0 "in CODE clause")
+            ;; If it's escaped it may be a function end breakpoint trap.
+            (when (and (code-component-p code)
+                       (eq (%code-debug-info code) :bogus-lra))
+              ;; If :bogus-lra grab the real lra.
+              (setq pc-offset (code-header-ref
+                               code (1+ real-lra-slot)))
+              (setq code (code-header-ref code real-lra-slot))
+              (aver code)))
+           (t
+            (/show0 "in T clause")
+            ;; not escaped
+            (multiple-value-setq (pc-offset code)
+              (compute-lra-data-from-pc ra))
+            (unless code
+              (setf code :foreign-function
+                    pc-offset 0
+                    escaped nil))))
+
+      (let ((d-fun (case code
+                    (:undefined-function
+                     (make-bogus-debug-function
+                      "undefined function"))
+                    (:foreign-function
+                     (make-bogus-debug-function
+                      "foreign function call land"))
+                    ((nil)
+                     (make-bogus-debug-function
+                      "bogus stack frame"))
+                    (t
+                     (debug-function-from-pc code pc-offset)))))
+       (/show0 "returning MAKE-COMPILED-FRAME from COMPUTE-CALLING-FRAME")
+       (make-compiled-frame caller up-frame d-fun
+                            (code-location-from-pc d-fun pc-offset
+                                                   escaped)
+                            (if up-frame (1+ (frame-number up-frame)) 0)
+                            escaped)))))
+
  #!+x86
  (defun find-escaped-frame (frame-pointer)
    (declare (type system-area-pointer frame-pointer))
  #!+x86
  (defun find-escaped-frame (frame-pointer)
    (declare (type system-area-pointer frame-pointer))
-  (dotimes (index sb!impl::*free-interrupt-context-index* (values nil 0 nil))
+  (/show0 "entering FIND-ESCAPED-FRAME")
+  (dotimes (index *free-interrupt-context-index* (values nil 0 nil))
      (sb!alien:with-alien
      (sb!alien:with-alien
-       ((lisp-interrupt-contexts (array (* os-context-t) nil)
-                                 :extern))
+       ((lisp-interrupt-contexts (array (* os-context-t) nil) :extern))
+      (/show0 "at head of WITH-ALIEN")
        (let ((context (sb!alien:deref lisp-interrupt-contexts index)))
        (let ((context (sb!alien:deref lisp-interrupt-contexts index)))
+       (/show0 "got CONTEXT")
         (when (= (sap-int frame-pointer)
                  (sb!vm:context-register context sb!vm::cfp-offset))
           (without-gcing
         (when (= (sap-int frame-pointer)
                  (sb!vm:context-register context sb!vm::cfp-offset))
           (without-gcing
+          (/show0 "in WITHOUT-GCING")
            (let* ((component-ptr (component-ptr-from-pc
                                   (sb!vm:context-pc context)))
            (let* ((component-ptr (component-ptr-from-pc
                                   (sb!vm:context-pc context)))
-                 (code (if (sap= component-ptr (int-sap #x0))
-                           nil ; FIXME: UNLESS might be clearer than IF.
-                           (component-from-component-ptr component-ptr))))
+                 (code (unless (sap= component-ptr (int-sap #x0))
+                         (component-from-component-ptr component-ptr))))
+            (/show0 "got CODE")
              (when (null code)
                (return (values code 0 context)))
              (let* ((code-header-len (* (get-header-data code)
              (when (null code)
                (return (values code 0 context)))
              (let* ((code-header-len (* (get-header-data code)
@@ -1120,20 +919,67 @@
                         (- (get-lisp-obj-address code)
                            sb!vm:other-pointer-type)
                         code-header-len)))
                         (- (get-lisp-obj-address code)
                            sb!vm:other-pointer-type)
                         code-header-len)))
+              (/show "got PC-OFFSET")
                (unless (<= 0 pc-offset
                            (* (code-header-ref code sb!vm:code-code-size-slot)
                               sb!vm:word-bytes))
                (unless (<= 0 pc-offset
                            (* (code-header-ref code sb!vm:code-code-size-slot)
                               sb!vm:word-bytes))
-                ;; We were in an assembly routine. Therefore, use the LRA as
-                ;; the pc.
+                ;; We were in an assembly routine. Therefore, use the
+                ;; LRA as the pc.
+                ;;
+                ;; FIXME: Should this be WARN or ERROR or what?
                  (format t "** pc-offset ~S not in code obj ~S?~%"
                          pc-offset code))
                  (format t "** pc-offset ~S not in code obj ~S?~%"
                          pc-offset code))
+              (/show0 "returning from FIND-ESCAPED-FRAME")
                (return
                 (values code pc-offset context))))))))))
  
                (return
                 (values code pc-offset context))))))))))
  
+#!-x86
+(defun find-escaped-frame (frame-pointer)
+  (declare (type system-area-pointer frame-pointer))
+  (dotimes (index *free-interrupt-context-index* (values nil 0 nil))
+    (sb!alien:with-alien
+     ((lisp-interrupt-contexts (array (* os-context-t) nil) :extern))
+     (let ((scp (sb!alien:deref lisp-interrupt-contexts index)))
+       (when (= (sap-int frame-pointer)
+                (sb!vm:context-register scp sb!vm::cfp-offset))
+         (without-gcing
+          (let ((code (code-object-from-bits
+                       (sb!vm:context-register scp sb!vm::code-offset))))
+            (when (symbolp code)
+              (return (values code 0 scp)))
+            (let* ((code-header-len (* (get-header-data code)
+                                       sb!vm:word-bytes))
+                   (pc-offset
+                    (- (sap-int (sb!vm:context-pc scp))
+                       (- (get-lisp-obj-address code)
+                          sb!vm:other-pointer-type)
+                       code-header-len)))
+              ;; Check to see whether we were executing in a branch
+              ;; delay slot.
+              #!+(or pmax sgi) ; pmax only (and broken anyway)
+              (when (logbitp 31 (sb!alien:slot scp '%mips::sc-cause))
+                (incf pc-offset sb!vm:word-bytes))
+              (unless (<= 0 pc-offset
+                          (* (code-header-ref code sb!vm:code-code-size-slot)
+                             sb!vm:word-bytes))
+                ;; We were in an assembly routine. Therefore, use the
+                ;; LRA as the pc.
+                (setf pc-offset
+                      (- (sb!vm:context-register scp sb!vm::lra-offset)
+                         (get-lisp-obj-address code)
+                         code-header-len)))
+               (return
+                (if (eq (%code-debug-info code) :bogus-lra)
+                    (let ((real-lra (code-header-ref code
+                                                     real-lra-slot)))
+                      (values (lra-code-header real-lra)
+                              (get-header-data real-lra)
+                              nil))
+                  (values code pc-offset scp)))))))))))
+
  ;;; Find the code object corresponding to the object represented by
  ;;; bits and return it. We assume bogus functions correspond to the
  ;;; undefined-function.
  ;;; Find the code object corresponding to the object represented by
  ;;; bits and return it. We assume bogus functions correspond to the
  ;;; undefined-function.
-#!-gengc
  (defun code-object-from-bits (bits)
    (declare (type (unsigned-byte 32) bits))
    (let ((object (make-lisp-obj bits)))
  (defun code-object-from-bits (bits)
    (declare (type (unsigned-byte 32) bits))
    (let ((object (make-lisp-obj bits)))
@@ -1149,32 +995,6 @@
                        (lra-code-header object))
                       (t
                        nil))))))))
                        (lra-code-header object))
                       (t
                        nil))))))))
-
-;;; SB!KERNEL:*SAVED-STATE-CHAIN* -- maintained by the C code as a
-;;; list of SAPs, each SAP pointing to a saved exception state.
-#!+gengc
-(declaim (special *saved-state-chain*))
-
-;;; CMU CL had
-;;;   (DEFUN LOOKUP-TRACE-TABLE-ENTRY (COMPONENT PC) ..)
-;;; for this case, but it hasn't been maintained in SBCL.
-#!+gengc
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (error "hopelessly stale"))
-
-;;; CMU CL had
-;;;   (DEFUN EXTRACT-INFO-FROM-STATE (STATE) ..)
-;;; for this case, but it hasn't been maintained in SBCL.
-#!+gengc
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (error "hopelessly stale"))
-
-;;; CMU CL had
-;;;   (DEFUN COMPUTE-CALLING-FRAME (OCFP RA UP-FRAME) ..)
-;;; for this case, but it hasn't been maintained in SBCL.
-#!+gengc
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (error "hopelessly stale"))
  \f
  ;;;; frame utilities
  
  \f
  ;;;; frame utilities
  
@@ -1187,7 +1007,7 @@
    (let ((info (%code-debug-info component)))
      (cond
       ((not info)
    (let ((info (%code-debug-info component)))
      (cond
       ((not info)
-      (debug-signal 'no-debug-info))
+      (debug-signal 'no-debug-info :code-component component))
       ((eq info :bogus-lra)
        (make-bogus-debug-function "function end breakpoint"))
       (t
       ((eq info :bogus-lra)
        (make-bogus-debug-function "function end breakpoint"))
       (t
@@ -1200,8 +1020,7 @@
                   (elsewhere-p
                    (>= pc (sb!c::compiled-debug-function-elsewhere-pc
                            (svref function-map 0)))))
                   (elsewhere-p
                    (>= pc (sb!c::compiled-debug-function-elsewhere-pc
                            (svref function-map 0)))))
-             ;; FIXME: I don't think SB!C is the home package of INDEX.
-             (declare (type sb!c::index i))
+             (declare (type sb!int:index i))
               (loop
                 (when (or (= i len)
                           (< pc (if elsewhere-p
               (loop
                 (when (or (= i len)
                           (< pc (if elsewhere-p
@@ -1231,16 +1050,13 @@
                    what)))))
        (make-compiled-code-location pc debug-fun)))
  
                    what)))))
        (make-compiled-code-location pc debug-fun)))
  
+;;; Return an alist mapping catch tags to CODE-LOCATIONs. These are
+;;; CODE-LOCATIONs at which execution would continue with frame as the
+;;; top frame if someone threw to the corresponding tag.
  (defun frame-catches (frame)
  (defun frame-catches (frame)
-  #!+sb-doc
-  "Returns an a-list mapping catch tags to code-locations. These are
-   code-locations at which execution would continue with frame as the top
-   frame if someone threw to the corresponding tag."
-  (let ((catch
-        #!-gengc (descriptor-sap sb!impl::*current-catch-block*)
-        #!+gengc (mutator-current-catch-block))
+  (let ((catch (descriptor-sap *current-catch-block*))
         (res nil)
         (res nil)
-       (fp (frame-pointer (frame-real-frame frame))))
+       (fp (frame-pointer frame)))
      (loop
        (when (zerop (sap-int catch)) (return (nreverse res)))
        (when (sap= fp
      (loop
        (when (zerop (sap-int catch)) (return (nreverse res)))
        (when (sap= fp
@@ -1253,9 +1069,9 @@
                    (sap-ref-32 catch
                                       (* sb!vm:catch-block-current-cont-slot
                                          sb!vm:word-bytes))))
                    (sap-ref-32 catch
                                       (* sb!vm:catch-block-current-cont-slot
                                          sb!vm:word-bytes))))
-       (let* (#!-(or gengc x86)
+       (let* (#!-x86
                (lra (stack-ref catch sb!vm:catch-block-entry-pc-slot))
                (lra (stack-ref catch sb!vm:catch-block-entry-pc-slot))
-              #!+(or gengc x86)
+              #!+x86
                (ra (sap-ref-sap
                     catch (* sb!vm:catch-block-entry-pc-slot
                              sb!vm:word-bytes)))
                (ra (sap-ref-sap
                     catch (* sb!vm:catch-block-entry-pc-slot
                              sb!vm:word-bytes)))
@@ -1266,15 +1082,10 @@
                (component (component-from-component-ptr
                            (component-ptr-from-pc ra)))
                (offset
                (component (component-from-component-ptr
                            (component-ptr-from-pc ra)))
                (offset
-               #!-(or gengc x86)
+               #!-x86
                 (* (- (1+ (get-header-data lra))
                       (get-header-data component))
                    sb!vm:word-bytes)
                 (* (- (1+ (get-header-data lra))
                       (get-header-data component))
                    sb!vm:word-bytes)
-               #!+gengc
-               (+ (- (sap-int ra)
-                     (get-lisp-obj-address component)
-                     (get-header-data component))
-                  sb!vm:other-pointer-type)
                 #!+x86
                 (- (sap-int ra)
                    (- (get-lisp-obj-address component)
                 #!+x86
                 (- (sap-int ra)
                    (- (get-lisp-obj-address component)
@@ -1299,23 +1110,17 @@
              (sap-ref-32 catch
                                 (* sb!vm:catch-block-previous-catch-slot
                                    sb!vm:word-bytes)))))))
              (sap-ref-32 catch
                                 (* sb!vm:catch-block-previous-catch-slot
                                    sb!vm:word-bytes)))))))
-
-;;; If an interpreted frame, return the real frame, otherwise frame.
-(defun frame-real-frame (frame)
-  (etypecase frame
-    (compiled-frame frame)
-    (interpreted-frame (interpreted-frame-real-frame frame))))
  \f
  ;;;; operations on DEBUG-FUNCTIONs
  
  \f
  ;;;; operations on DEBUG-FUNCTIONs
  
+;;; Execute the forms in a context with block-var bound to each
+;;; debug-block in debug-function successively. Result is an optional
+;;; form to execute for return values, and DO-DEBUG-FUNCTION-BLOCKS
+;;; returns nil if there is no result form. This signals a
+;;; no-debug-blocks condition when the debug-function lacks
+;;; debug-block information.
  (defmacro do-debug-function-blocks ((block-var debug-function &optional result)
                                     &body body)
  (defmacro do-debug-function-blocks ((block-var debug-function &optional result)
                                     &body body)
-  #!+sb-doc
-  "Executes the forms in a context with block-var bound to each debug-block in
-   debug-function successively. Result is an optional form to execute for
-   return values, and DO-DEBUG-FUNCTION-BLOCKS returns nil if there is no
-   result form. This signals a no-debug-blocks condition when the
-   debug-function lacks debug-block information."
    (let ((blocks (gensym))
         (i (gensym)))
      `(let ((,blocks (debug-function-debug-blocks ,debug-function)))
    (let ((blocks (gensym))
         (i (gensym)))
      `(let ((,blocks (debug-function-debug-blocks ,debug-function)))
@@ -1324,14 +1129,13 @@
          (let ((,block-var (svref ,blocks ,i)))
            ,@body)))))
  
          (let ((,block-var (svref ,blocks ,i)))
            ,@body)))))
  
+;;; Execute body in a context with var bound to each debug-var in
+;;; debug-function. This returns the value of executing result (defaults to
+;;; nil). This may iterate over only some of debug-function's variables or none
+;;; depending on debug policy; for example, possibly the compilation only
+;;; preserved argument information.
  (defmacro do-debug-function-variables ((var debug-function &optional result)
                                        &body body)
  (defmacro do-debug-function-variables ((var debug-function &optional result)
                                        &body body)
-  #!+sb-doc
-  "Executes body in a context with var bound to each debug-var in
-   debug-function. This returns the value of executing result (defaults to
-   nil). This may iterate over only some of debug-function's variables or none
-   depending on debug policy; for example, possibly the compilation only
-   preserved argument information."
    (let ((vars (gensym))
         (i (gensym)))
      `(let ((,vars (debug-function-debug-vars ,debug-function)))
    (let ((vars (gensym))
         (i (gensym)))
      `(let ((,vars (debug-function-debug-vars ,debug-function)))
@@ -1342,11 +1146,10 @@
                ,@body))
            ,result))))
  
                ,@body))
            ,result))))
  
+;;; Return the Common Lisp function associated with the debug-function. This
+;;; returns nil if the function is unavailable or is non-existent as a user
+;;; callable function object.
  (defun debug-function-function (debug-function)
  (defun debug-function-function (debug-function)
-  #!+sb-doc
-  "Returns the Common Lisp function associated with the debug-function. This
-   returns nil if the function is unavailable or is non-existent as a user
-   callable function object."
    (let ((cached-value (debug-function-%function debug-function)))
      (if (eq cached-value :unparsed)
         (setf (debug-function-%function debug-function)
    (let ((cached-value (debug-function-%function debug-function)))
      (if (eq cached-value :unparsed)
         (setf (debug-function-%function debug-function)
@@ -1366,48 +1169,34 @@
                                (compiled-debug-function-compiler-debug-fun
                                 (function-debug-function entry))))
                        (return entry)))))
                                (compiled-debug-function-compiler-debug-fun
                                 (function-debug-function entry))))
                        (return entry)))))
-               (interpreted-debug-function
-                (sb!c::lambda-eval-info-function
-                 (sb!c::leaf-info
-                  (interpreted-debug-function-ir1-lambda debug-function))))
                 (bogus-debug-function nil)))
         cached-value)))
  
                 (bogus-debug-function nil)))
         cached-value)))
  
+;;; Return the name of the function represented by debug-function. This may
+;;; be a string or a cons; do not assume it is a symbol.
  (defun debug-function-name (debug-function)
  (defun debug-function-name (debug-function)
-  #!+sb-doc
-  "Returns the name of the function represented by debug-function. This may
-   be a string or a cons; do not assume it is a symbol."
    (etypecase debug-function
      (compiled-debug-function
       (sb!c::compiled-debug-function-name
        (compiled-debug-function-compiler-debug-fun debug-function)))
    (etypecase debug-function
      (compiled-debug-function
       (sb!c::compiled-debug-function-name
        (compiled-debug-function-compiler-debug-fun debug-function)))
-    (interpreted-debug-function
-     (sb!c::lambda-name (interpreted-debug-function-ir1-lambda
-                        debug-function)))
      (bogus-debug-function
       (bogus-debug-function-%name debug-function))))
  
      (bogus-debug-function
       (bogus-debug-function-%name debug-function))))
  
+;;; Return a debug-function that represents debug information for function.
  (defun function-debug-function (fun)
  (defun function-debug-function (fun)
-  #!+sb-doc
-  "Returns a debug-function that represents debug information for function."
-  (case (get-type fun)
+  (ecase (get-type fun)
      (#.sb!vm:closure-header-type
       (function-debug-function (%closure-function fun)))
      (#.sb!vm:funcallable-instance-header-type
      (#.sb!vm:closure-header-type
       (function-debug-function (%closure-function fun)))
      (#.sb!vm:funcallable-instance-header-type
-     (cond ((sb!eval:interpreted-function-p fun)
-           (make-interpreted-debug-function
-            (or (sb!eval::interpreted-function-definition fun)
-                (sb!eval::convert-interpreted-fun fun))))
-          (t
-           (function-debug-function (funcallable-instance-function fun)))))
+     (function-debug-function (funcallable-instance-function fun)))
      ((#.sb!vm:function-header-type #.sb!vm:closure-function-header-type)
        (let* ((name (%function-name fun))
              (component (function-code-header fun))
              (res (find-if
      ((#.sb!vm:function-header-type #.sb!vm:closure-function-header-type)
        (let* ((name (%function-name fun))
              (component (function-code-header fun))
              (res (find-if
-                  #'(lambda (x)
-                      (and (sb!c::compiled-debug-function-p x)
-                           (eq (sb!c::compiled-debug-function-name x) name)
-                           (eq (sb!c::compiled-debug-function-kind x) nil)))
+                  (lambda (x)
+                    (and (sb!c::compiled-debug-function-p x)
+                         (eq (sb!c::compiled-debug-function-name x) name)
+                         (eq (sb!c::compiled-debug-function-kind x) nil)))
                    (get-debug-info-function-map
                     (%code-debug-info component)))))
         (if res
                    (get-debug-info-function-map
                     (%code-debug-info component)))))
         (if res
@@ -1425,35 +1214,29 @@
                                           (get-header-data component))
                                        sb!vm:word-bytes)))))))
  
                                           (get-header-data component))
                                        sb!vm:word-bytes)))))))
  
+;;; Return the kind of the function, which is one of :OPTIONAL,
+;;; :EXTERNAL, TOP-level, :CLEANUP, or NIL.
  (defun debug-function-kind (debug-function)
  (defun debug-function-kind (debug-function)
-  #!+sb-doc
-  "Returns the kind of the function which is one of :OPTIONAL, :EXTERNAL,
-   :TOP-level, :CLEANUP, or NIL."
    ;; FIXME: This "is one of" information should become part of the function
    ;; declamation, not just a doc string
    (etypecase debug-function
      (compiled-debug-function
       (sb!c::compiled-debug-function-kind
        (compiled-debug-function-compiler-debug-fun debug-function)))
    ;; FIXME: This "is one of" information should become part of the function
    ;; declamation, not just a doc string
    (etypecase debug-function
      (compiled-debug-function
       (sb!c::compiled-debug-function-kind
        (compiled-debug-function-compiler-debug-fun debug-function)))
-    (interpreted-debug-function
-     (sb!c::lambda-kind (interpreted-debug-function-ir1-lambda
-                        debug-function)))
      (bogus-debug-function
       nil)))
  
      (bogus-debug-function
       nil)))
  
+;;; Is there any variable information for DEBUG-FUNCTION?
  (defun debug-var-info-available (debug-function)
  (defun debug-var-info-available (debug-function)
-  #!+sb-doc
-  "Is there any variable information for DEBUG-FUNCTION?"
    (not (not (debug-function-debug-vars debug-function))))
  
    (not (not (debug-function-debug-vars debug-function))))
  
+;;; Return a list of debug-vars in debug-function having the same name
+;;; and package as symbol. If symbol is uninterned, then this returns
+;;; a list of debug-vars without package names and with the same name
+;;; as symbol. The result of this function is limited to the
+;;; availability of variable information in debug-function; for
+;;; example, possibly DEBUG-FUNCTION only knows about its arguments.
  (defun debug-function-symbol-variables (debug-function symbol)
  (defun debug-function-symbol-variables (debug-function symbol)
-  #!+sb-doc
-  "Returns a list of debug-vars in debug-function having the same name
-   and package as symbol. If symbol is uninterned, then this returns a list of
-   debug-vars without package names and with the same name as symbol. The
-   result of this function is limited to the availability of variable
-   information in debug-function; for example, possibly debug-function only
-   knows about its arguments."
    (let ((vars (ambiguous-debug-vars debug-function (symbol-name symbol)))
         (package (and (symbol-package symbol)
                       (package-name (symbol-package symbol)))))
    (let ((vars (ambiguous-debug-vars debug-function (symbol-name symbol)))
         (package (and (symbol-package symbol)
                       (package-name (symbol-package symbol)))))
@@ -1466,11 +1249,12 @@
                      (stringp (debug-var-package-name var))))
                vars)))
  
                      (stringp (debug-var-package-name var))))
                vars)))
  
+;;; Return a list of debug-vars in debug-function whose names contain
+;;; name-prefix-string as an intial substring. The result of this
+;;; function is limited to the availability of variable information in
+;;; debug-function; for example, possibly debug-function only knows
+;;; about its arguments.
  (defun ambiguous-debug-vars (debug-function name-prefix-string)
  (defun ambiguous-debug-vars (debug-function name-prefix-string)
-   "Returns a list of debug-vars in debug-function whose names contain
-    name-prefix-string as an intial substring. The result of this function is
-    limited to the availability of variable information in debug-function; for
-    example, possibly debug-function only knows about its arguments."
    (declare (simple-string name-prefix-string))
    (let ((variables (debug-function-debug-vars debug-function)))
      (declare (type (or null simple-vector) variables))
    (declare (simple-string name-prefix-string))
    (let ((variables (debug-function-debug-vars debug-function)))
      (declare (type (or null simple-vector) variables))
@@ -1511,95 +1295,32 @@
                                (string= x y :end1 name-len :end2 name-len))))
               :end (or end (length variables)))))
  
                                (string= x y :end1 name-len :end2 name-len))))
               :end (or end (length variables)))))
  
+;;; Return a list representing the lambda-list for DEBUG-FUNCTION. The
+;;; list has the following structure:
+;;;   (required-var1 required-var2
+;;;    ...
+;;;    (:optional var3 suppliedp-var4)
+;;;    (:optional var5)
+;;;    ...
+;;;    (:rest var6) (:rest var7)
+;;;    ...
+;;;    (:keyword keyword-symbol var8 suppliedp-var9)
+;;;    (:keyword keyword-symbol var10)
+;;;    ...
+;;;   )
+;;; Each VARi is a DEBUG-VAR; however it may be the symbol :DELETED if
+;;; it is unreferenced in DEBUG-FUNCTION. This signals a
+;;; LAMBDA-LIST-UNAVAILABLE condition when there is no argument list
+;;; information.
  (defun debug-function-lambda-list (debug-function)
  (defun debug-function-lambda-list (debug-function)
-  #!+sb-doc
-  "Returns a list representing the lambda-list for debug-function. The list
-   has the following structure:
-      (required-var1 required-var2
-       ...
-       (:optional var3 suppliedp-var4)
-       (:optional var5)
-       ...
-       (:rest var6) (:rest var7)
-       ...
-       (:keyword keyword-symbol var8 suppliedp-var9)
-       (:keyword keyword-symbol var10)
-       ...
-      )
-   Each VARi is a DEBUG-VAR; however it may be the symbol :deleted it
-   is unreferenced in debug-function. This signals a lambda-list-unavailable
-   condition when there is no argument list information."
    (etypecase debug-function
      (compiled-debug-function
       (compiled-debug-function-lambda-list debug-function))
    (etypecase debug-function
      (compiled-debug-function
       (compiled-debug-function-lambda-list debug-function))
-    (interpreted-debug-function
-     (interpreted-debug-function-lambda-list debug-function))
      (bogus-debug-function
       nil)))
  
      (bogus-debug-function
       nil)))
  
-;;; The hard part is when the lambda-list is unparsed. If it is
-;;; unparsed, and all the arguments are required, this is still pretty
-;;; easy; just whip the appropriate DEBUG-VARs into a list. Otherwise,
-;;; we have to pick out the funny arguments including any suppliedp
-;;; variables. In this situation, the ir1-lambda is an external entry
-;;; point that takes arguments users really pass in. It looks at those
-;;; and computes defaults and suppliedp variables, ultimately passing
-;;; everything defined as a a parameter to the real function as final
-;;; arguments. If this has to compute the lambda list, it caches it in
-;;; debug-function.
-(defun interpreted-debug-function-lambda-list (debug-function)
-  (let ((lambda-list (debug-function-%lambda-list debug-function))
-       (debug-vars (debug-function-debug-vars debug-function))
-       (ir1-lambda (interpreted-debug-function-ir1-lambda debug-function))
-       (res nil))
-    (if (eq lambda-list :unparsed)
-       (flet ((frob (v debug-vars)
-                (if (sb!c::lambda-var-refs v)
-                    (find v debug-vars
-                          :key #'interpreted-debug-var-ir1-var)
-                    :deleted)))
-         (let ((xep-args (sb!c::lambda-optional-dispatch ir1-lambda)))
-           (if (and xep-args
-                    (eq (sb!c::optional-dispatch-main-entry xep-args)
-                        ir1-lambda))
-               ;; There are rest, optional, keyword, and suppliedp vars.
-               (let ((final-args (sb!c::lambda-vars ir1-lambda)))
-                 (dolist (xep-arg (sb!c::optional-dispatch-arglist xep-args))
-                   (let ((info (sb!c::lambda-var-arg-info xep-arg))
-                         (final-arg (pop final-args)))
-                     (cond (info
-                            (case (sb!c::arg-info-kind info)
-                              (:required
-                               (push (frob final-arg debug-vars) res))
-                              (:keyword
-                               (push (list :keyword
-                                           (sb!c::arg-info-keyword info)
-                                           (frob final-arg debug-vars))
-                                     res))
-                              (:rest
-                               (push (list :rest (frob final-arg debug-vars))
-                                     res))
-                              (:optional
-                               (push (list :optional
-                                           (frob final-arg debug-vars))
-                                     res)))
-                            (when (sb!c::arg-info-supplied-p info)
-                              (nconc
-                               (car res)
-                               (list (frob (pop final-args) debug-vars)))))
-                           (t
-                            (push (frob final-arg debug-vars) res)))))
-                 (setf (debug-function-%lambda-list debug-function)
-                       (nreverse res)))
-               ;; All required args, so return them in a list.
-               (dolist (v (sb!c::lambda-vars ir1-lambda)
-                          (setf (debug-function-%lambda-list debug-function)
-                                (nreverse res)))
-                 (push (frob v debug-vars) res)))))
-       ;; Everything's unparsed and cached, so return it.
-       lambda-list)))
-
-;;; If this has to compute the lambda list, it caches it in debug-function.
+;;; Note: If this has to compute the lambda list, it caches it in
+;;; DEBUG-FUNCTION.
  (defun compiled-debug-function-lambda-list (debug-function)
    (let ((lambda-list (debug-function-%lambda-list debug-function)))
      (cond ((eq lambda-list :unparsed)
  (defun compiled-debug-function-lambda-list (debug-function)
    (let ((lambda-list (debug-function-%lambda-list debug-function)))
      (cond ((eq lambda-list :unparsed)
@@ -1674,11 +1395,11 @@
                        res))
                 (sb!c::more-arg
                  ;; Just ignore the fact that the next two args are
                        res))
                 (sb!c::more-arg
                  ;; Just ignore the fact that the next two args are
-                ;; the more arg context and count, and act like they
+                ;; the &MORE arg context and count, and act like they
                  ;; are regular arguments.
                  nil)
                 (t
                  ;; are regular arguments.
                  nil)
                 (t
-                ;; keyword arg
+                ;; &KEY arg
                  (push (list :keyword
                              ele
                              (compiled-debug-function-lambda-list-var
                  (push (list :keyword
                              ele
                              (compiled-debug-function-lambda-list-var
@@ -1769,16 +1490,14 @@
            (debug-signal 'no-debug-blocks
                          :debug-function debug-function)))))
  
            (debug-signal 'no-debug-blocks
                          :debug-function debug-function)))))
  
-;;; This returns a simple-vector of debug-blocks or nil. NIL indicates
+;;; This returns a SIMPLE-VECTOR of DEBUG-BLOCKs or NIL. NIL indicates
  ;;; there was no basic block information.
  (defun parse-debug-blocks (debug-function)
    (etypecase debug-function
      (compiled-debug-function
       (parse-compiled-debug-blocks debug-function))
      (bogus-debug-function
  ;;; there was no basic block information.
  (defun parse-debug-blocks (debug-function)
    (etypecase debug-function
      (compiled-debug-function
       (parse-compiled-debug-blocks debug-function))
      (bogus-debug-function
-     (debug-signal 'no-debug-blocks :debug-function debug-function))
-    (interpreted-debug-function
-     (parse-interpreted-debug-blocks debug-function))))
+     (debug-signal 'no-debug-blocks :debug-function debug-function))))
  
  ;;; This does some of the work of PARSE-DEBUG-BLOCKS.
  (defun parse-compiled-debug-blocks (debug-function)
  
  ;;; This does some of the work of PARSE-DEBUG-BLOCKS.
  (defun parse-compiled-debug-blocks (debug-function)
@@ -1809,7 +1528,7 @@
               (let* ((locations
                       (dotimes (k (sb!c::read-var-integer blocks i)
                                   (result locations-buffer))
               (let* ((locations
                       (dotimes (k (sb!c::read-var-integer blocks i)
                                   (result locations-buffer))
-                       (let ((kind (svref sb!c::compiled-code-location-kinds
+                       (let ((kind (svref sb!c::*compiled-code-location-kinds*
                                            (aref+ blocks i)))
                               (pc (+ last-pc
                                      (sb!c::read-var-integer blocks i)))
                                            (aref+ blocks i)))
                               (pc (+ last-pc
                                      (sb!c::read-var-integer blocks i)))
@@ -1843,21 +1562,10 @@
               (setf (debug-block-successors block) succs)))
           res)))))
  
               (setf (debug-block-successors block) succs)))
           res)))))
  
-;;; This does some of the work of PARSE-DEBUG-BLOCKS.
-(defun parse-interpreted-debug-blocks (debug-function)
-  (let ((ir1-lambda (interpreted-debug-function-ir1-lambda debug-function)))
-    (with-parsing-buffer (buffer)
-      (sb!c::do-blocks (block (sb!c::block-component
-                              (sb!c::node-block (sb!c::lambda-bind
-                                                 ir1-lambda))))
-       (when (eq ir1-lambda (sb!c::block-home-lambda block))
-         (vector-push-extend (make-interpreted-debug-block block) buffer)))
-      (result buffer))))
-
-;;; The argument is a debug internals structure. This returns nil if
+;;; The argument is a debug internals structure. This returns NIL if
  ;;; there is no variable information. It returns an empty
  ;;; simple-vector if there were no locals in the function. Otherwise
  ;;; there is no variable information. It returns an empty
  ;;; simple-vector if there were no locals in the function. Otherwise
-;;; it returns a simple-vector of DEBUG-VARs.
+;;; it returns a SIMPLE-VECTOR of DEBUG-VARs.
  (defun debug-function-debug-vars (debug-function)
    (let ((vars (debug-function-%debug-vars debug-function)))
      (if (eq vars :unparsed)
  (defun debug-function-debug-vars (debug-function)
    (let ((vars (debug-function-%debug-vars debug-function)))
      (if (eq vars :unparsed)
@@ -1865,58 +1573,12 @@
               (etypecase debug-function
                 (compiled-debug-function
                  (parse-compiled-debug-vars debug-function))
               (etypecase debug-function
                 (compiled-debug-function
                  (parse-compiled-debug-vars debug-function))
-               (bogus-debug-function nil)
-               (interpreted-debug-function
-                (parse-interpreted-debug-vars debug-function))))
+               (bogus-debug-function nil)))
         vars)))
  
         vars)))
  
-;;; This grabs all the variables from DEBUG-FUN's ir1-lambda, from the
-;;; IR1 lambda vars, and all of its LET's. Each LET is an IR1 lambda.
-;;; For each variable, we make an INTERPRETED-DEBUG-VAR. We then SORT
-;;; all the variables by name. Then we go through, and for any
-;;; duplicated names we distinguish the INTERPRETED-DEBUG-VARs by
-;;; setting their id slots to a distinct number.
-(defun parse-interpreted-debug-vars (debug-fun)
-  (let* ((ir1-lambda (interpreted-debug-function-ir1-lambda debug-fun))
-        (vars (flet ((frob (ir1-lambda buf)
-                       (dolist (v (sb!c::lambda-vars ir1-lambda))
-                         (vector-push-extend
-                          (let* ((id (sb!c::leaf-name v)))
-                            (make-interpreted-debug-var id v))
-                          buf))))
-                (with-parsing-buffer (buf)
-                  (frob ir1-lambda buf)
-                  (dolist (let-lambda (sb!c::lambda-lets ir1-lambda))
-                    (frob let-lambda buf))
-                  (result buf)))))
-    (declare (simple-vector vars))
-    (sort vars #'string< :key #'debug-var-symbol-name)
-    (let ((len (length vars)))
-      (when (> len 1)
-       (let ((i 0)
-             (j 1))
-         (block PUNT
-           (loop
-             (let* ((var-i (svref vars i))
-                    (var-j (svref vars j))
-                    (name (debug-var-symbol-name var-i)))
-               (when (string= name (debug-var-symbol-name var-j))
-                 (let ((count 1))
-                   (loop
-                     (setf (debug-var-id var-j) count)
-                     (when (= (incf j) len) (return-from PUNT))
-                     (setf var-j (svref vars j))
-                     (when (string/= name (debug-var-symbol-name var-j))
-                       (return))
-                     (incf count))))
-               (setf i j)
-               (incf j)
-               (when (= j len) (return))))))))
-    vars))
-
-;;; Vars is the parsed variables for a minimal debug function. We need to
-;;; assign names of the form ARG-NNN. We must pad with leading zeros, since
-;;; the arguments must be in alphabetical order.
+;;; VARS is the parsed variables for a minimal debug function. We need
+;;; to assign names of the form ARG-NNN. We must pad with leading
+;;; zeros, since the arguments must be in alphabetical order.
  (defun assign-minimal-var-names (vars)
    (declare (simple-vector vars))
    (let* ((len (length vars))
  (defun assign-minimal-var-names (vars)
    (declare (simple-vector vars))
    (let* ((len (length vars))
@@ -1925,8 +1587,8 @@
        (setf (compiled-debug-var-symbol (svref vars i))
             (intern (format nil "ARG-~V,'0D" width i)
                     ;; KLUDGE: It's somewhat nasty to have a bare
        (setf (compiled-debug-var-symbol (svref vars i))
             (intern (format nil "ARG-~V,'0D" width i)
                     ;; KLUDGE: It's somewhat nasty to have a bare
-                   ;; package name string here. It would probably be
-                   ;; better to have #.(FIND-PACKAGE "SB!DEBUG")
+                   ;; package name string here. It would be
+                   ;; nicer to have #.(FIND-PACKAGE "SB!DEBUG")
                     ;; instead, since then at least it would transform
                     ;; correctly under package renaming and stuff.
                     ;; However, genesis can't handle dumped packages..
                     ;; instead, since then at least it would transform
                     ;; correctly under package renaming and stuff.
                     ;; However, genesis can't handle dumped packages..
@@ -1938,13 +1600,15 @@
                     ;; would work fine) If this is possible, it would
                     ;; probably be a good thing, since minimizing the
                     ;; amount of stuff in cold init is basically good.
                     ;; would work fine) If this is possible, it would
                     ;; probably be a good thing, since minimizing the
                     ;; amount of stuff in cold init is basically good.
-                   "SB-DEBUG")))))
+                   (or (find-package "SB-DEBUG")
+                       (find-package "SB!DEBUG")))))))
  
  ;;; Parse the packed representation of DEBUG-VARs from
  ;;; DEBUG-FUNCTION's SB!C::COMPILED-DEBUG-FUNCTION, returning a vector
  ;;; of DEBUG-VARs, or NIL if there was no information to parse.
  (defun parse-compiled-debug-vars (debug-function)
  
  ;;; Parse the packed representation of DEBUG-VARs from
  ;;; DEBUG-FUNCTION's SB!C::COMPILED-DEBUG-FUNCTION, returning a vector
  ;;; of DEBUG-VARs, or NIL if there was no information to parse.
  (defun parse-compiled-debug-vars (debug-function)
-  (let* ((cdebug-fun (compiled-debug-function-compiler-debug-fun debug-function))
+  (let* ((cdebug-fun (compiled-debug-function-compiler-debug-fun
+                     debug-function))
          (packed-vars (sb!c::compiled-debug-function-variables cdebug-fun))
          (args-minimal (eq (sb!c::compiled-debug-function-arguments cdebug-fun)
                            :minimal)))
          (packed-vars (sb!c::compiled-debug-function-variables cdebug-fun))
          (args-minimal (eq (sb!c::compiled-debug-function-arguments cdebug-fun)
                            :minimal)))
@@ -1960,7 +1624,8 @@
           (let* ((flags (geti))
                  (minimal (logtest sb!c::compiled-debug-var-minimal-p flags))
                  (deleted (logtest sb!c::compiled-debug-var-deleted-p flags))
           (let* ((flags (geti))
                  (minimal (logtest sb!c::compiled-debug-var-minimal-p flags))
                  (deleted (logtest sb!c::compiled-debug-var-deleted-p flags))
-                (live (logtest sb!c::compiled-debug-var-environment-live flags))
+                (live (logtest sb!c::compiled-debug-var-environment-live
+                               flags))
                  (save (logtest sb!c::compiled-debug-var-save-loc-p flags))
                  (symbol (if minimal nil (geti)))
                  (id (if (logtest sb!c::compiled-debug-var-id-p flags)
                  (save (logtest sb!c::compiled-debug-var-save-loc-p flags))
                  (symbol (if minimal nil (geti)))
                  (id (if (logtest sb!c::compiled-debug-var-id-p flags)
@@ -1968,7 +1633,7 @@
                          0))
                  (sc-offset (if deleted 0 (geti)))
                  (save-sc-offset (if save (geti) nil)))
                          0))
                  (sc-offset (if deleted 0 (geti)))
                  (save-sc-offset (if save (geti) nil)))
-           (assert (not (and args-minimal (not minimal))))
+           (aver (not (and args-minimal (not minimal))))
             (vector-push-extend (make-compiled-debug-var symbol
                                                          id
                                                          live
             (vector-push-extend (make-compiled-debug-var symbol
                                                          id
                                                          live
@@ -1999,7 +1664,7 @@
        (if (logtest flags sb!c::minimal-debug-function-setf-bit)
           `(setf ,base)
           base))
        (if (logtest flags sb!c::minimal-debug-function-setf-bit)
           `(setf ,base)
           base))
-    :kind (svref sb!c::minimal-debug-function-kinds
+    :kind (svref sb!c::*minimal-debug-function-kinds*
                  (ldb sb!c::minimal-debug-function-kind-byte options))
      :variables
      (when vars-p
                  (ldb sb!c::minimal-debug-function-kind-byte options))
      :variables
      (when vars-p
@@ -2063,14 +1728,14 @@
  
        (coerce (cdr (res)) 'simple-vector))))
  
  
        (coerce (cdr (res)) 'simple-vector))))
  
-;;; This variable maps minimal debug-info function maps to an unpacked
-;;; version thereof.
+;;; a map from minimal DEBUG-INFO function maps to unpacked
+;;; versions thereof
  (defvar *uncompacted-function-maps* (make-hash-table :test 'eq))
  
  (defvar *uncompacted-function-maps* (make-hash-table :test 'eq))
  
-;;; Return a function-map for a given compiled-debug-info object. If
+;;; Return a FUNCTION-MAP for a given COMPILED-DEBUG-info object. If
  ;;; the info is minimal, and has not been parsed, then parse it.
  ;;;
  ;;; the info is minimal, and has not been parsed, then parse it.
  ;;;
-;;; FIXME: Now that we no longer use the minimal-debug-function
+;;; FIXME: Now that we no longer use the MINIMAL-DEBUG-FUNCTION
  ;;; representation, calls to this function can be replaced by calls to
  ;;; the bare COMPILED-DEBUG-INFO-FUNCTION-MAP slot accessor function,
  ;;; and this function and everything it calls become dead code which
  ;;; representation, calls to this function can be replaced by calls to
  ;;; the bare COMPILED-DEBUG-INFO-FUNCTION-MAP slot accessor function,
  ;;; and this function and everything it calls become dead code which
@@ -2086,17 +1751,14 @@
  \f
  ;;;; CODE-LOCATIONs
  
  \f
  ;;;; CODE-LOCATIONs
  
-;;; If we're sure of whether code-location is known, return t or nil.
-;;; If we're :unsure, then try to fill in the code-location's slots.
+;;; If we're sure of whether code-location is known, return T or NIL.
+;;; If we're :UNSURE, then try to fill in the code-location's slots.
  ;;; This determines whether there is any debug-block information, and
  ;;; if code-location is known.
  ;;;
  ;;; ??? IF this conses closures every time it's called, then break off the
  ;;; This determines whether there is any debug-block information, and
  ;;; if code-location is known.
  ;;;
  ;;; ??? IF this conses closures every time it's called, then break off the
-;;; :unsure part to get the HANDLER-CASE into another function.
+;;; :UNSURE part to get the HANDLER-CASE into another function.
  (defun code-location-unknown-p (basic-code-location)
  (defun code-location-unknown-p (basic-code-location)
-  #!+sb-doc
-  "Returns whether basic-code-location is unknown. It returns nil when the
-   code-location is known."
    (ecase (code-location-%unknown-p basic-code-location)
      ((t) t)
      ((nil) nil)
    (ecase (code-location-%unknown-p basic-code-location)
      ((t) t)
      ((nil) nil)
@@ -2105,27 +1767,24 @@
            (handler-case (not (fill-in-code-location basic-code-location))
              (no-debug-blocks () t))))))
  
            (handler-case (not (fill-in-code-location basic-code-location))
              (no-debug-blocks () t))))))
  
+;;; Return the DEBUG-BLOCK containing code-location if it is available.
+;;; Some debug policies inhibit debug-block information, and if none
+;;; is available, then this signals a NO-DEBUG-BLOCKS condition.
  (defun code-location-debug-block (basic-code-location)
  (defun code-location-debug-block (basic-code-location)
-  #!+sb-doc
-  "Returns the debug-block containing code-location if it is available. Some
-   debug policies inhibit debug-block information, and if none is available,
-   then this signals a no-debug-blocks condition."
    (let ((block (code-location-%debug-block basic-code-location)))
      (if (eq block :unparsed)
         (etypecase basic-code-location
           (compiled-code-location
            (compute-compiled-code-location-debug-block basic-code-location))
    (let ((block (code-location-%debug-block basic-code-location)))
      (if (eq block :unparsed)
         (etypecase basic-code-location
           (compiled-code-location
            (compute-compiled-code-location-debug-block basic-code-location))
-         (interpreted-code-location
-          (setf (code-location-%debug-block basic-code-location)
-                (make-interpreted-debug-block
-                 (sb!c::node-block
-                  (interpreted-code-location-ir1-node basic-code-location))))))
+         ;; (There used to be more cases back before sbcl-0.7.0, when
+         ;; we did special tricks to debug the IR1 interpreter.)
+         )
         block)))
  
         block)))
  
-;;; This stores and returns BASIC-CODE-LOCATION's debug-block. It
-;;; determines the correct one using the code-location's pc. This uses
+;;; Store and return BASIC-CODE-LOCATION's debug-block. We determines
+;;; the correct one using the code-location's pc. We use
  ;;; DEBUG-FUNCTION-DEBUG-BLOCKS to return the cached block information
  ;;; DEBUG-FUNCTION-DEBUG-BLOCKS to return the cached block information
-;;; or signal a 'no-debug-blocks condition. The blocks are sorted by
+;;; or signal a NO-DEBUG-BLOCKS condition. The blocks are sorted by
  ;;; their first code-location's pc, in ascending order. Therefore, as
  ;;; soon as we find a block that starts with a pc greater than
  ;;; basic-code-location's pc, we know the previous block contains the
  ;;; their first code-location's pc, in ascending order. Therefore, as
  ;;; soon as we find a block that starts with a pc greater than
  ;;; basic-code-location's pc, we know the previous block contains the
@@ -2170,9 +1829,8 @@
                                  0)))
                   (return (svref blocks (1- i)))))))))
  
                                  0)))
                   (return (svref blocks (1- i)))))))))
  
+;;; Return the CODE-LOCATION's DEBUG-SOURCE.
  (defun code-location-debug-source (code-location)
  (defun code-location-debug-source (code-location)
-  #!+sb-doc
-  "Returns the code-location's debug-source."
    (etypecase code-location
      (compiled-code-location
       (let* ((info (compiled-debug-function-debug-info
    (etypecase code-location
      (compiled-code-location
       (let* ((info (compiled-debug-function-debug-info
@@ -2191,21 +1849,15 @@
                ((null src) (car prev))
              (when (< offset (sb!c::debug-source-source-root (car src)))
                (return (car prev)))))))
                ((null src) (car prev))
              (when (< offset (sb!c::debug-source-source-root (car src)))
                (return (car prev)))))))
-    (interpreted-code-location
-     (first
-      (let ((sb!c::*lexenv* (make-null-lexenv)))
-       (sb!c::debug-source-for-info
-        (sb!c::component-source-info
-         (sb!c::block-component
-          (sb!c::node-block
-           (interpreted-code-location-ir1-node code-location))))))))))
-
+    ;; (There used to be more cases back before sbcl-0.7.0, when we
+    ;; did special tricks to debug the IR1 interpreter.)
+    ))
+
+;;; Returns the number of top-level forms before the one containing
+;;; CODE-LOCATION as seen by the compiler in some compilation unit. (A
+;;; compilation unit is not necessarily a single file, see the section
+;;; on debug-sources.)
  (defun code-location-top-level-form-offset (code-location)
  (defun code-location-top-level-form-offset (code-location)
-  #!+sb-doc
-  "Returns the number of top-level forms before the one containing
-   code-location as seen by the compiler in some compilation unit. A
-   compilation unit is not necessarily a single file, see the section on
-   debug-sources."
    (when (code-location-unknown-p code-location)
      (error 'unknown-code-location :code-location code-location))
    (let ((tlf-offset (code-location-%tlf-offset code-location)))
    (when (code-location-unknown-p code-location)
      (error 'unknown-code-location :code-location code-location))
    (let ((tlf-offset (code-location-%tlf-offset code-location)))
@@ -2217,18 +1869,16 @@
                 ;; debug info the compiler should have dumped.
                 (error "internal error: unknown code location"))
               (code-location-%tlf-offset code-location))
                 ;; debug info the compiler should have dumped.
                 (error "internal error: unknown code location"))
               (code-location-%tlf-offset code-location))
-            (interpreted-code-location
-             (setf (code-location-%tlf-offset code-location)
-                   (sb!c::source-path-tlf-number
-                    (sb!c::node-source-path
-                     (interpreted-code-location-ir1-node code-location)))))))
+            ;; (There used to be more cases back before sbcl-0.7.0,,
+            ;; when we did special tricks to debug the IR1
+            ;; interpreter.)
+            ))
           (t tlf-offset))))
  
           (t tlf-offset))))
  
+;;; Return the number of the form corresponding to CODE-LOCATION. The
+;;; form number is derived by a walking the subforms of a top-level
+;;; form in depth-first order.
  (defun code-location-form-number (code-location)
  (defun code-location-form-number (code-location)
-  #!+sb-doc
-  "Returns the number of the form corresponding to code-location. The form
-   number is derived by a walking the subforms of a top-level form in
-   depth-first order."
    (when (code-location-unknown-p code-location)
      (error 'unknown-code-location :code-location code-location))
    (let ((form-num (code-location-%form-number code-location)))
    (when (code-location-unknown-p code-location)
      (error 'unknown-code-location :code-location code-location))
    (let ((form-num (code-location-%form-number code-location)))
@@ -2240,19 +1890,17 @@
                 ;; debug info the compiler should have dumped.
                 (error "internal error: unknown code location"))
               (code-location-%form-number code-location))
                 ;; debug info the compiler should have dumped.
                 (error "internal error: unknown code location"))
               (code-location-%form-number code-location))
-            (interpreted-code-location
-             (setf (code-location-%form-number code-location)
-                   (sb!c::source-path-form-number
-                    (sb!c::node-source-path
-                     (interpreted-code-location-ir1-node code-location)))))))
+            ;; (There used to be more cases back before sbcl-0.7.0,,
+            ;; when we did special tricks to debug the IR1
+            ;; interpreter.)
+            ))
           (t form-num))))
  
           (t form-num))))
  
+;;; Return the kind of CODE-LOCATION, one of:
+;;;  :INTERPRETED, :UNKNOWN-RETURN, :KNOWN-RETURN, :INTERNAL-ERROR,
+;;;  :NON-LOCAL-EXIT, :BLOCK-START, :CALL-SITE, :SINGLE-VALUE-RETURN,
+;;;  :NON-LOCAL-ENTRY
  (defun code-location-kind (code-location)
  (defun code-location-kind (code-location)
-  #!+sb-doc
-  "Return the kind of CODE-LOCATION, one of:
-     :interpreted, :unknown-return, :known-return, :internal-error,
-     :non-local-exit, :block-start, :call-site, :single-value-return,
-     :non-local-entry"
    (when (code-location-unknown-p code-location)
      (error 'unknown-code-location :code-location code-location))
    (etypecase code-location
    (when (code-location-unknown-p code-location)
      (error 'unknown-code-location :code-location code-location))
    (etypecase code-location
@@ -2265,8 +1913,10 @@
               (error "internal error: unknown code location"))
              (t
               (compiled-code-location-kind code-location)))))
               (error "internal error: unknown code location"))
              (t
               (compiled-code-location-kind code-location)))))
-    (interpreted-code-location
-     :interpreted)))
+    ;; (There used to be more cases back before sbcl-0.7.0,,
+    ;; when we did special tricks to debug the IR1
+    ;; interpreter.)
+    ))
  
  ;;; This returns CODE-LOCATION's live-set if it is available. If
  ;;; there is no debug-block information, this returns NIL.
  
  ;;; This returns CODE-LOCATION's live-set if it is available. If
  ;;; there is no debug-block information, this returns NIL.
@@ -2276,8 +1926,8 @@
        (let ((live-set (compiled-code-location-%live-set code-location)))
         (cond ((eq live-set :unparsed)
                (unless (fill-in-code-location code-location)
        (let ((live-set (compiled-code-location-%live-set code-location)))
         (cond ((eq live-set :unparsed)
                (unless (fill-in-code-location code-location)
-                ;; This check should be unnecessary. We're missing debug info
-                ;; the compiler should have dumped.
+                ;; This check should be unnecessary. We're missing
+                ;; debug info the compiler should have dumped.
                  ;;
                  ;; FIXME: This error and comment happen over and over again.
                  ;; Make them a shared function.
                  ;;
                  ;; FIXME: This error and comment happen over and over again.
                  ;; Make them a shared function.
@@ -2285,9 +1935,8 @@
                (compiled-code-location-%live-set code-location))
               (t live-set)))))
  
                (compiled-code-location-%live-set code-location))
               (t live-set)))))
  
+;;; true if OBJ1 and OBJ2 are the same place in the code
  (defun code-location= (obj1 obj2)
  (defun code-location= (obj1 obj2)
-  #!+sb-doc
-  "Returns whether obj1 and obj2 are the same place in the code."
    (etypecase obj1
      (compiled-code-location
       (etypecase obj2
    (etypecase obj1
      (compiled-code-location
       (etypecase obj2
@@ -2295,20 +1944,19 @@
         (and (eq (code-location-debug-function obj1)
                  (code-location-debug-function obj2))
              (sub-compiled-code-location= obj1 obj2)))
         (and (eq (code-location-debug-function obj1)
                  (code-location-debug-function obj2))
              (sub-compiled-code-location= obj1 obj2)))
-       (interpreted-code-location
-       nil)))
-    (interpreted-code-location
-     (etypecase obj2
-       (compiled-code-location
-       nil)
-       (interpreted-code-location
-       (eq (interpreted-code-location-ir1-node obj1)
-           (interpreted-code-location-ir1-node obj2)))))))
+       ;; (There used to be more cases back before sbcl-0.7.0,,
+       ;; when we did special tricks to debug the IR1
+       ;; interpreter.)
+       ))
+    ;; (There used to be more cases back before sbcl-0.7.0,,
+    ;; when we did special tricks to debug the IR1
+    ;; interpreter.)
+    ))
  (defun sub-compiled-code-location= (obj1 obj2)
    (= (compiled-code-location-pc obj1)
       (compiled-code-location-pc obj2)))
  
  (defun sub-compiled-code-location= (obj1 obj2)
    (= (compiled-code-location-pc obj1)
       (compiled-code-location-pc obj2)))
  
-;;; This fills in CODE-LOCATION's :unparsed slots. It returns t or nil
+;;; Fill in CODE-LOCATION's :UNPARSED slots, returning T or NIL
  ;;; depending on whether the code-location was known in its
  ;;; debug-function's debug-block information. This may signal a
  ;;; NO-DEBUG-BLOCKS condition due to DEBUG-FUNCTION-DEBUG-BLOCKS, and
  ;;; depending on whether the code-location was known in its
  ;;; debug-function's debug-block information. This may signal a
  ;;; NO-DEBUG-BLOCKS condition due to DEBUG-FUNCTION-DEBUG-BLOCKS, and
@@ -2338,23 +1986,21 @@
  \f
  ;;;; operations on DEBUG-BLOCKs
  
  \f
  ;;;; operations on DEBUG-BLOCKs
  
-(defmacro do-debug-block-locations ((code-var debug-block &optional return)
+;;; Execute FORMS in a context with CODE-VAR bound to each
+;;; CODE-LOCATION in DEBUG-BLOCK, and return the value of RESULT.
+(defmacro do-debug-block-locations ((code-var debug-block &optional result)
                                     &body body)
                                     &body body)
-  #!+sb-doc
-  "Executes forms in a context with code-var bound to each code-location in
-   debug-block. This returns the value of executing result (defaults to nil)."
    (let ((code-locations (gensym))
         (i (gensym)))
      `(let ((,code-locations (debug-block-code-locations ,debug-block)))
         (declare (simple-vector ,code-locations))
    (let ((code-locations (gensym))
         (i (gensym)))
      `(let ((,code-locations (debug-block-code-locations ,debug-block)))
         (declare (simple-vector ,code-locations))
-       (dotimes (,i (length ,code-locations) ,return)
+       (dotimes (,i (length ,code-locations) ,result)
          (let ((,code-var (svref ,code-locations ,i)))
            ,@body)))))
  
          (let ((,code-var (svref ,code-locations ,i)))
            ,@body)))))
  
+;;; Return the name of the function represented by DEBUG-FUNCTION.
+;;; This may be a string or a cons; do not assume it is a symbol.
  (defun debug-block-function-name (debug-block)
  (defun debug-block-function-name (debug-block)
-  #!+sb-doc
-  "Returns the name of the function represented by debug-function. This may
-   be a string or a cons; do not assume it is a symbol."
    (etypecase debug-block
      (compiled-debug-block
       (let ((code-locs (compiled-debug-block-code-locations debug-block)))
    (etypecase debug-block
      (compiled-debug-block
       (let ((code-locs (compiled-debug-block-code-locations debug-block)))
@@ -2363,32 +2009,17 @@
            "??? Can't get name of debug-block's function."
            (debug-function-name
             (code-location-debug-function (svref code-locs 0))))))
            "??? Can't get name of debug-block's function."
            (debug-function-name
             (code-location-debug-function (svref code-locs 0))))))
-    (interpreted-debug-block
-     (sb!c::lambda-name (sb!c::block-home-lambda
-                        (interpreted-debug-block-ir1-block debug-block))))))
+    ;; (There used to be more cases back before sbcl-0.7.0, when we
+    ;; did special tricks to debug the IR1 interpreter.)
+    ))
  
  (defun debug-block-code-locations (debug-block)
    (etypecase debug-block
      (compiled-debug-block
       (compiled-debug-block-code-locations debug-block))
  
  (defun debug-block-code-locations (debug-block)
    (etypecase debug-block
      (compiled-debug-block
       (compiled-debug-block-code-locations debug-block))
-    (interpreted-debug-block
-     (interpreted-debug-block-code-locations debug-block))))
-
-(defun interpreted-debug-block-code-locations (debug-block)
-  (let ((code-locs (interpreted-debug-block-locations debug-block)))
-    (if (eq code-locs :unparsed)
-       (with-parsing-buffer (buf)
-         (sb!c::do-nodes (node cont (interpreted-debug-block-ir1-block
-                                  debug-block))
-           (vector-push-extend (make-interpreted-code-location
-                                node
-                                (make-interpreted-debug-function
-                                 (sb!c::block-home-lambda (sb!c::node-block
-                                                           node))))
-                               buf))
-         (setf (interpreted-debug-block-locations debug-block)
-               (result buf)))
-       code-locs)))
+    ;; (There used to be more cases back before sbcl-0.7.0, when we
+    ;; did special tricks to debug the IR1 interpreter.)
+    ))
  \f
  ;;;; operations on debug variables
  
  \f
  ;;;; operations on debug variables
  
@@ -2401,48 +2032,38 @@
  (defun debug-var-package-name (debug-var)
    (package-name (symbol-package (debug-var-symbol debug-var))))
  
  (defun debug-var-package-name (debug-var)
    (package-name (symbol-package (debug-var-symbol debug-var))))
  
+;;; Return the value stored for DEBUG-VAR in frame, or if the value is
+;;; not :VALID, then signal an INVALID-VALUE error.
  (defun debug-var-valid-value (debug-var frame)
  (defun debug-var-valid-value (debug-var frame)
-  #!+sb-doc
-  "Returns the value stored for DEBUG-VAR in frame. If the value is not
-   :valid, then this signals an invalid-value error."
    (unless (eq (debug-var-validity debug-var (frame-code-location frame))
               :valid)
      (error 'invalid-value :debug-var debug-var :frame frame))
    (debug-var-value debug-var frame))
  
    (unless (eq (debug-var-validity debug-var (frame-code-location frame))
               :valid)
      (error 'invalid-value :debug-var debug-var :frame frame))
    (debug-var-value debug-var frame))
  
+;;; Returns the value stored for DEBUG-VAR in frame. The value may be
+;;; invalid. This is SETFable.
  (defun debug-var-value (debug-var frame)
  (defun debug-var-value (debug-var frame)
-  #!+sb-doc
-  "Returns the value stored for DEBUG-VAR in frame. The value may be
-   invalid. This is SETF'able."
-  (etypecase debug-var
-    (compiled-debug-var
-     (check-type frame compiled-frame)
-     (let ((res (access-compiled-debug-var-slot debug-var frame)))
-       (if (indirect-value-cell-p res)
-          (sb!c:value-cell-ref res)
-          res)))
-    (interpreted-debug-var
-     (check-type frame interpreted-frame)
-     (sb!eval::leaf-value-lambda-var
-      (interpreted-code-location-ir1-node (frame-code-location frame))
-      (interpreted-debug-var-ir1-var debug-var)
-      (frame-pointer frame)
-      (interpreted-frame-closure frame)))))
+  (aver (typep frame 'compiled-frame))
+  (let ((res (access-compiled-debug-var-slot debug-var frame)))
+    (if (indirect-value-cell-p res)
+       (value-cell-ref res)
+       res)))
  
  ;;; This returns what is stored for the variable represented by
  ;;; DEBUG-VAR relative to the FRAME. This may be an indirect value
  ;;; cell if the variable is both closed over and set.
  (defun access-compiled-debug-var-slot (debug-var frame)
  
  ;;; This returns what is stored for the variable represented by
  ;;; DEBUG-VAR relative to the FRAME. This may be an indirect value
  ;;; cell if the variable is both closed over and set.
  (defun access-compiled-debug-var-slot (debug-var frame)
+  (declare (optimize (speed 1)))
    (let ((escaped (compiled-frame-escaped frame)))
      (if escaped
    (let ((escaped (compiled-frame-escaped frame)))
      (if escaped
-       (sub-access-debug-var-slot
-        (frame-pointer frame)
-        (compiled-debug-var-sc-offset debug-var)
-        escaped)
-       (sub-access-debug-var-slot
-        (frame-pointer frame)
-        (or (compiled-debug-var-save-sc-offset debug-var)
-            (compiled-debug-var-sc-offset debug-var))))))
+        (sub-access-debug-var-slot
+         (frame-pointer frame)
+         (compiled-debug-var-sc-offset debug-var)
+         escaped)
+      (sub-access-debug-var-slot
+       (frame-pointer frame)
+       (or (compiled-debug-var-save-sc-offset debug-var)
+           (compiled-debug-var-sc-offset debug-var))))))
  
  ;;; a helper function for working with possibly-invalid values:
  ;;; Do (MAKE-LISP-OBJ VAL) only if the value looks valid.
  
  ;;; a helper function for working with possibly-invalid values:
  ;;; Do (MAKE-LISP-OBJ VAL) only if the value looks valid.
@@ -2452,7 +2073,7 @@
  ;;; those variables are invalid.)
  (defun make-valid-lisp-obj (val)
    (/show0 "entering MAKE-VALID-LISP-OBJ, VAL=..")
  ;;; those variables are invalid.)
  (defun make-valid-lisp-obj (val)
    (/show0 "entering MAKE-VALID-LISP-OBJ, VAL=..")
-  #!+sb-show (%primitive print (sb!impl::hexstr val))
+  #!+sb-show (/hexstr val)
    (if (or
         ;; fixnum
         (zerop (logand val 3))
    (if (or
         ;; fixnum
         (zerop (logand val 3))
@@ -2477,27 +2098,161 @@
        (make-lisp-obj val)
        :invalid-object))
  
        (make-lisp-obj val)
        :invalid-object))
  
-;;; CMU CL had
-;;;   (DEFUN SUB-ACCESS-DEBUG-VAR-SLOT (FP SC-OFFSET &OPTIONAL ESCAPED) ..)
-;;; code for this case.
  #!-x86
  #!-x86
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (error "hopelessly stale"))
+(defun sub-access-debug-var-slot (fp sc-offset &optional escaped)
+  (macrolet ((with-escaped-value ((var) &body forms)
+               `(if escaped
+                    (let ((,var (sb!vm:context-register
+                                 escaped
+                                 (sb!c:sc-offset-offset sc-offset))))
+                      ,@forms)
+                    :invalid-value-for-unescaped-register-storage))
+             (escaped-float-value (format)
+               `(if escaped
+                    (sb!vm:context-float-register
+                     escaped
+                     (sb!c:sc-offset-offset sc-offset)
+                     ',format)
+                    :invalid-value-for-unescaped-register-storage))
+             (with-nfp ((var) &body body)
+               `(let ((,var (if escaped
+                                (sb!sys:int-sap
+                                 (sb!vm:context-register escaped
+                                                         sb!vm::nfp-offset))
+                                #!-alpha
+                                (sb!sys:sap-ref-sap fp (* sb!vm::nfp-save-offset
+                                                          sb!vm:word-bytes))
+                                #!+alpha
+                                (sb!vm::make-number-stack-pointer
+                                 (sb!sys:sap-ref-32 fp (* sb!vm::nfp-save-offset
+                                                          sb!vm:word-bytes))))))
+                  ,@body)))
+    (ecase (sb!c:sc-offset-scn sc-offset)
+      ((#.sb!vm:any-reg-sc-number
+        #.sb!vm:descriptor-reg-sc-number
+        #!+rt #.sb!vm:word-pointer-reg-sc-number)
+       (sb!sys:without-gcing
+        (with-escaped-value (val) (sb!kernel:make-lisp-obj val))))
+                            
+      (#.sb!vm:base-char-reg-sc-number
+       (with-escaped-value (val)
+         (code-char val)))
+      (#.sb!vm:sap-reg-sc-number
+       (with-escaped-value (val)
+         (sb!sys:int-sap val)))
+      (#.sb!vm:signed-reg-sc-number
+       (with-escaped-value (val)
+         (if (logbitp (1- sb!vm:word-bits) val)
+             (logior val (ash -1 sb!vm:word-bits))
+             val)))
+      (#.sb!vm:unsigned-reg-sc-number
+       (with-escaped-value (val)
+         val))
+      (#.sb!vm:non-descriptor-reg-sc-number
+       (error "Local non-descriptor register access?"))
+      (#.sb!vm:interior-reg-sc-number
+       (error "Local interior register access?"))
+      (#.sb!vm:single-reg-sc-number
+       (escaped-float-value single-float))
+      (#.sb!vm:double-reg-sc-number
+       (escaped-float-value double-float))
+      #!+long-float
+      (#.sb!vm:long-reg-sc-number
+       (escaped-float-value long-float))
+      (#.sb!vm:complex-single-reg-sc-number
+       (if escaped
+           (complex
+            (sb!vm:context-float-register
+             escaped (sb!c:sc-offset-offset sc-offset) 'single-float)
+            (sb!vm:context-float-register
+             escaped (1+ (sb!c:sc-offset-offset sc-offset)) 'single-float))
+           :invalid-value-for-unescaped-register-storage))
+      (#.sb!vm:complex-double-reg-sc-number
+       (if escaped
+           (complex
+            (sb!vm:context-float-register
+             escaped (sb!c:sc-offset-offset sc-offset) 'double-float)
+            (sb!vm:context-float-register
+             escaped (+ (sb!c:sc-offset-offset sc-offset) #!+sparc 2 #-sparc 1)
+             'double-float))
+           :invalid-value-for-unescaped-register-storage))
+      #!+long-float
+      (#.sb!vm:complex-long-reg-sc-number
+       (if escaped
+           (complex
+            (sb!vm:context-float-register
+             escaped (sb!c:sc-offset-offset sc-offset) 'long-float)
+            (sb!vm:context-float-register
+             escaped (+ (sb!c:sc-offset-offset sc-offset) #!+sparc 4)
+             'long-float))
+           :invalid-value-for-unescaped-register-storage))
+      (#.sb!vm:single-stack-sc-number
+       (with-nfp (nfp)
+         (sb!sys:sap-ref-single nfp (* (sb!c:sc-offset-offset sc-offset)
+                                       sb!vm:word-bytes))))
+      (#.sb!vm:double-stack-sc-number
+       (with-nfp (nfp)
+         (sb!sys:sap-ref-double nfp (* (sb!c:sc-offset-offset sc-offset)
+                                       sb!vm:word-bytes))))
+      #!+long-float
+      (#.sb!vm:long-stack-sc-number
+       (with-nfp (nfp)
+         (sb!sys:sap-ref-long nfp (* (sb!c:sc-offset-offset sc-offset)
+                                     sb!vm:word-bytes))))
+      (#.sb!vm:complex-single-stack-sc-number
+       (with-nfp (nfp)
+         (complex
+          (sb!sys:sap-ref-single nfp (* (sb!c:sc-offset-offset sc-offset)
+                                        sb!vm:word-bytes))
+          (sb!sys:sap-ref-single nfp (* (1+ (sb!c:sc-offset-offset sc-offset))
+                                        sb!vm:word-bytes)))))
+      (#.sb!vm:complex-double-stack-sc-number
+       (with-nfp (nfp)
+         (complex
+          (sb!sys:sap-ref-double nfp (* (sb!c:sc-offset-offset sc-offset)
+                                        sb!vm:word-bytes))
+          (sb!sys:sap-ref-double nfp (* (+ (sb!c:sc-offset-offset sc-offset) 2)
+                                        sb!vm:word-bytes)))))
+      #!+long-float
+      (#.sb!vm:complex-long-stack-sc-number
+       (with-nfp (nfp)
+         (complex
+          (sb!sys:sap-ref-long nfp (* (sb!c:sc-offset-offset sc-offset)
+                                      sb!vm:word-bytes))
+          (sb!sys:sap-ref-long nfp (* (+ (sb!c:sc-offset-offset sc-offset)
+                                         #!+sparc 4)
+                                      sb!vm:word-bytes)))))
+      (#.sb!vm:control-stack-sc-number
+       (sb!kernel:stack-ref fp (sb!c:sc-offset-offset sc-offset)))
+      (#.sb!vm:base-char-stack-sc-number
+       (with-nfp (nfp)
+         (code-char (sb!sys:sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset)
+                                              sb!vm:word-bytes)))))
+      (#.sb!vm:unsigned-stack-sc-number
+       (with-nfp (nfp)
+         (sb!sys:sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset)
+                                   sb!vm:word-bytes))))
+      (#.sb!vm:signed-stack-sc-number
+       (with-nfp (nfp)
+         (sb!sys:signed-sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset)
+                                          sb!vm:word-bytes))))
+      (#.sb!vm:sap-stack-sc-number
+       (with-nfp (nfp)
+         (sb!sys:sap-ref-sap nfp (* (sb!c:sc-offset-offset sc-offset)
+                                    sb!vm:word-bytes)))))))
  
  #!+x86
  (defun sub-access-debug-var-slot (fp sc-offset &optional escaped)
    (declare (type system-area-pointer fp))
    (/show0 "entering SUB-ACCESS-DEBUG-VAR-SLOT, FP,SC-OFFSET,ESCAPED=..")
  
  #!+x86
  (defun sub-access-debug-var-slot (fp sc-offset &optional escaped)
    (declare (type system-area-pointer fp))
    (/show0 "entering SUB-ACCESS-DEBUG-VAR-SLOT, FP,SC-OFFSET,ESCAPED=..")
-  #!+sb-show (%primitive print (sb!impl::hexstr fp))
-  #!+sb-show (%primitive print (sb!impl::hexstr sc-offset))
-  #!+sb-show (%primitive print (sb!impl::hexstr escaped))
+  (/hexstr fp) (/hexstr sc-offset) (/hexstr escaped)
    (macrolet ((with-escaped-value ((var) &body forms)
                `(if escaped
                     (let ((,var (sb!vm:context-register
                                  escaped
                                  (sb!c:sc-offset-offset sc-offset))))
                       (/show0 "in escaped case, ,VAR value=..")
    (macrolet ((with-escaped-value ((var) &body forms)
                `(if escaped
                     (let ((,var (sb!vm:context-register
                                  escaped
                                  (sb!c:sc-offset-offset sc-offset))))
                       (/show0 "in escaped case, ,VAR value=..")
-                     #!+sb-show (%primitive print (sb!impl::hexstr ,var))
+                     (/hexstr ,var)
                       ,@forms)
                     :invalid-value-for-unescaped-register-storage))
              (escaped-float-value (format)
                       ,@forms)
                     :invalid-value-for-unescaped-register-storage))
              (escaped-float-value (format)
@@ -2519,7 +2274,7 @@
         (without-gcing
         (with-escaped-value (val)
           (/show0 "VAL=..")
         (without-gcing
         (with-escaped-value (val)
           (/show0 "VAL=..")
-         #!+sb-show (%primitive print (sb!impl::hexstr val))
+         (/hexstr val)
           (make-valid-lisp-obj val))))
        (#.sb!vm:base-char-reg-sc-number
         (/show0 "case of BASE-CHAR-REG-SC-NUMBER")
           (make-valid-lisp-obj val))))
        (#.sb!vm:base-char-reg-sc-number
         (/show0 "case of BASE-CHAR-REG-SC-NUMBER")
@@ -2618,28 +2373,16 @@
  ;;; This stores value as the value of DEBUG-VAR in FRAME. In the
  ;;; COMPILED-DEBUG-VAR case, access the current value to determine if
  ;;; it is an indirect value cell. This occurs when the variable is
  ;;; This stores value as the value of DEBUG-VAR in FRAME. In the
  ;;; COMPILED-DEBUG-VAR case, access the current value to determine if
  ;;; it is an indirect value cell. This occurs when the variable is
-;;; both closed over and set. For INTERPRETED-DEBUG-VARs just call
-;;; SB!EVAL::SET-LEAF-VALUE-LAMBDA-VAR with the right interpreter
-;;; objects.
-(defun %set-debug-var-value (debug-var frame value)
-  (etypecase debug-var
-    (compiled-debug-var
-     (check-type frame compiled-frame)
-     (let ((current-value (access-compiled-debug-var-slot debug-var frame)))
-       (if (indirect-value-cell-p current-value)
-          (sb!c:value-cell-set current-value value)
-          (set-compiled-debug-var-slot debug-var frame value))))
-    (interpreted-debug-var
-     (check-type frame interpreted-frame)
-     (sb!eval::set-leaf-value-lambda-var
-      (interpreted-code-location-ir1-node (frame-code-location frame))
-      (interpreted-debug-var-ir1-var debug-var)
-      (frame-pointer frame)
-      (interpreted-frame-closure frame)
-      value)))
-  value)
-
-;;; This stores value for the variable represented by debug-var
+;;; both closed over and set.
+(defun %set-debug-var-value (debug-var frame new-value)
+  (aver (typep frame 'compiled-frame))
+  (let ((old-value (access-compiled-debug-var-slot debug-var frame)))
+    (if (indirect-value-cell-p old-value)
+       (value-cell-set old-value new-value)
+       (set-compiled-debug-var-slot debug-var frame new-value)))
+  new-value)
+
+;;; This stores VALUE for the variable represented by debug-var
  ;;; relative to the frame. This assumes the location directly contains
  ;;; the variable's value; that is, there is no indirect value cell
  ;;; currently there in case the variable is both closed over and set.
  ;;; relative to the frame. This assumes the location directly contains
  ;;; the variable's value; that is, there is no indirect value cell
  ;;; currently there in case the variable is both closed over and set.
@@ -2679,13 +2422,13 @@
                                                          sb!vm::nfp-offset))
                                 #!-alpha
                                 (sap-ref-sap fp
                                                          sb!vm::nfp-offset))
                                 #!-alpha
                                 (sap-ref-sap fp
-                                                   (* sb!vm::nfp-save-offset
-                                                      sb!vm:word-bytes))
+                                            (* sb!vm::nfp-save-offset
+                                               sb!vm:word-bytes))
                                 #!+alpha
                                 #!+alpha
-                               (%alpha::make-number-stack-pointer
+                               (sb!vm::make-number-stack-pointer
                                  (sap-ref-32 fp
                                  (sap-ref-32 fp
-                                                   (* sb!vm::nfp-save-offset
-                                                      sb!vm:word-bytes))))))
+                                            (* sb!vm::nfp-save-offset
+                                               sb!vm:word-bytes))))))
                   ,@body)))
      (ecase (sb!c:sc-offset-scn sc-offset)
        ((#.sb!vm:any-reg-sc-number
                   ,@body)))
      (ecase (sb!c:sc-offset-scn sc-offset)
        ((#.sb!vm:any-reg-sc-number
@@ -2916,33 +2659,28 @@
    (and (= (get-lowtag x) sb!vm:other-pointer-type)
         (= (get-type x) sb!vm:value-cell-header-type)))
  
    (and (= (get-lowtag x) sb!vm:other-pointer-type)
         (= (get-type x) sb!vm:value-cell-header-type)))
  
+;;; Return three values reflecting the validity of DEBUG-VAR's value
+;;; at BASIC-CODE-LOCATION:
+;;;   :VALID    The value is known to be available.
+;;;   :INVALID  The value is known to be unavailable.
+;;;   :UNKNOWN  The value's availability is unknown.
+;;;
  ;;; If the variable is always alive, then it is valid. If the
  ;;; code-location is unknown, then the variable's validity is
  ;;; :unknown. Once we've called CODE-LOCATION-UNKNOWN-P, we know the
  ;;; live-set information has been cached in the code-location.
  (defun debug-var-validity (debug-var basic-code-location)
  ;;; If the variable is always alive, then it is valid. If the
  ;;; code-location is unknown, then the variable's validity is
  ;;; :unknown. Once we've called CODE-LOCATION-UNKNOWN-P, we know the
  ;;; live-set information has been cached in the code-location.
  (defun debug-var-validity (debug-var basic-code-location)
-  #!+sb-doc
-  "Returns three values reflecting the validity of DEBUG-VAR's value
-   at BASIC-CODE-LOCATION:
-      :VALID    The value is known to be available.
-      :INVALID  The value is known to be unavailable.
-      :UNKNOWN  The value's availability is unknown."
    (etypecase debug-var
      (compiled-debug-var
       (compiled-debug-var-validity debug-var basic-code-location))
    (etypecase debug-var
      (compiled-debug-var
       (compiled-debug-var-validity debug-var basic-code-location))
-    (interpreted-debug-var
-     (check-type basic-code-location interpreted-code-location)
-     (let ((validp (rassoc (interpreted-debug-var-ir1-var debug-var)
-                          (sb!c::lexenv-variables
-                           (sb!c::node-lexenv
-                            (interpreted-code-location-ir1-node
-                             basic-code-location))))))
-       (if validp :valid :invalid)))))
+    ;; (There used to be more cases back before sbcl-0.7.0, when
+    ;; we did special tricks to debug the IR1 interpreter.)
+    ))
  
  ;;; This is the method for DEBUG-VAR-VALIDITY for COMPILED-DEBUG-VARs.
  ;;; For safety, make sure basic-code-location is what we think.
  (defun compiled-debug-var-validity (debug-var basic-code-location)
  
  ;;; This is the method for DEBUG-VAR-VALIDITY for COMPILED-DEBUG-VARs.
  ;;; For safety, make sure basic-code-location is what we think.
  (defun compiled-debug-var-validity (debug-var basic-code-location)
-  (check-type basic-code-location compiled-code-location)
+  (declare (type compiled-code-location basic-code-location))
    (cond ((debug-var-alive-p debug-var)
          (let ((debug-fun (code-location-debug-function basic-code-location)))
            (if (>= (compiled-code-location-pc basic-code-location)
    (cond ((debug-var-alive-p debug-var)
          (let ((debug-fun (code-location-debug-function basic-code-location)))
            (if (>= (compiled-code-location-pc basic-code-location)
@@ -2954,14 +2692,16 @@
         (t
          (let ((pos (position debug-var
                               (debug-function-debug-vars
         (t
          (let ((pos (position debug-var
                               (debug-function-debug-vars
-                              (code-location-debug-function basic-code-location)))))
+                              (code-location-debug-function
+                               basic-code-location)))))
            (unless pos
              (error 'unknown-debug-var
                     :debug-var debug-var
                     :debug-function
                     (code-location-debug-function basic-code-location)))
            ;; There must be live-set info since basic-code-location is known.
            (unless pos
              (error 'unknown-debug-var
                     :debug-var debug-var
                     :debug-function
                     (code-location-debug-function basic-code-location)))
            ;; There must be live-set info since basic-code-location is known.
-          (if (zerop (sbit (compiled-code-location-live-set basic-code-location)
+          (if (zerop (sbit (compiled-code-location-live-set
+                            basic-code-location)
                             pos))
                :invalid
                :valid)))))
                             pos))
                :invalid
                :valid)))))
@@ -2985,21 +2725,21 @@
  ;;; Given the DEFUN, 3 gets you the LET, 1 gets you the bindings, 0
  ;;; gets the first binding, and 1 gets the AREF form.
  
  ;;; Given the DEFUN, 3 gets you the LET, 1 gets you the bindings, 0
  ;;; gets the first binding, and 1 gets the AREF form.
  
-;;; Temporary buffer used to build form-number => source-path translation in
-;;; FORM-NUMBER-TRANSLATIONS.
+;;; temporary buffer used to build form-number => source-path translation in
+;;; FORM-NUMBER-TRANSLATIONS
  (defvar *form-number-temp* (make-array 10 :fill-pointer 0 :adjustable t))
  
  (defvar *form-number-temp* (make-array 10 :fill-pointer 0 :adjustable t))
  
-;;; Table used to detect CAR circularities in FORM-NUMBER-TRANSLATIONS.
+;;; table used to detect CAR circularities in FORM-NUMBER-TRANSLATIONS
  (defvar *form-number-circularity-table* (make-hash-table :test 'eq))
  
  (defvar *form-number-circularity-table* (make-hash-table :test 'eq))
  
+;;; This returns a table mapping form numbers to source-paths. A source-path
+;;; indicates a descent into the top-level-form form, going directly to the
+;;; subform corressponding to the form number.
+;;;
  ;;; The vector elements are in the same format as the compiler's
  ;;; The vector elements are in the same format as the compiler's
-;;; NODE-SOUCE-PATH; that is, the first element is the form number and the last
-;;; is the top-level-form number.
+;;; NODE-SOURCE-PATH; that is, the first element is the form number and
+;;; the last is the top-level-form number.
  (defun form-number-translations (form tlf-number)
  (defun form-number-translations (form tlf-number)
-  #!+sb-doc
-  "This returns a table mapping form numbers to source-paths. A source-path
-   indicates a descent into the top-level-form form, going directly to the
-   subform corressponding to the form number."
    (clrhash *form-number-circularity-table*)
    (setf (fill-pointer *form-number-temp*) 0)
    (sub-translate-form-numbers form (list tlf-number))
    (clrhash *form-number-circularity-table*)
    (setf (fill-pointer *form-number-temp*) 0)
    (sub-translate-form-numbers form (list tlf-number))
@@ -3027,13 +2767,13 @@
           (frob)
           (setq trail (cdr trail)))))))
  
           (frob)
           (setq trail (cdr trail)))))))
  
+;;; FORM is a top-level form, and path is a source-path into it. This
+;;; returns the form indicated by the source-path. Context is the
+;;; number of enclosing forms to return instead of directly returning
+;;; the source-path form. When context is non-zero, the form returned
+;;; contains a marker, #:****HERE****, immediately before the form
+;;; indicated by path.
  (defun source-path-context (form path context)
  (defun source-path-context (form path context)
-  #!+sb-doc
-  "Form is a top-level form, and path is a source-path into it. This returns
-   the form indicated by the source-path. Context is the number of enclosing
-   forms to return instead of directly returning the source-path form. When
-   context is non-zero, the form returned contains a marker, #:****HERE****,
-   immediately before the form indicated by path."
    (declare (type unsigned-byte context))
    ;; Get to the form indicated by path or the enclosing form indicated
    ;; by context and path.
    (declare (type unsigned-byte context))
    ;; Get to the form indicated by path or the enclosing form indicated
    ;; by context and path.
@@ -3063,19 +2803,18 @@
                               (cons res (nthcdr (1+ n) form))))))))
        (frob form path context))))
  \f
                               (cons res (nthcdr (1+ n) form))))))))
        (frob form path context))))
  \f
-;;;; PREPROCESS-FOR-EVAL and EVAL-IN-FRAME
+;;;; PREPROCESS-FOR-EVAL
  
  
-;;; Create a SYMBOL-MACROLET for each variable valid at the location which
-;;; accesses that variable from the frame argument.
+;;; Return a function of one argument that evaluates form in the
+;;; lexical context of the BASIC-CODE-LOCATION LOC, or signal a
+;;; NO-DEBUG-VARS condition when the LOC's DEBUG-FUNCTION has no
+;;; DEBUG-VAR information available.
+;;;
+;;; The returned function takes the frame to get values from as its
+;;; argument, and it returns the values of FORM. The returned function
+;;; can signal the following conditions: INVALID-VALUE,
+;;; AMBIGUOUS-VARIABLE-NAME, and FRAME-FUNCTION-MISMATCH.
  (defun preprocess-for-eval (form loc)
  (defun preprocess-for-eval (form loc)
-  #!+sb-doc
-  "Return a function of one argument that evaluates form in the lexical
-   context of the basic-code-location loc. PREPROCESS-FOR-EVAL signals a
-   no-debug-vars condition when the loc's debug-function has no
-   debug-var information available. The returned function takes the frame
-   to get values from as its argument, and it returns the values of form.
-   The returned function signals the following conditions: invalid-value,
-   ambiguous-variable-name, and frame-function-mismatch"
    (declare (type code-location loc))
    (let ((n-frame (gensym))
         (fun (code-location-debug-function loc)))
    (declare (type code-location loc))
    (let ((n-frame (gensym))
         (fun (code-location-debug-function loc)))
@@ -3116,54 +2855,50 @@
               (debug-signal 'frame-function-mismatch
                             :code-location loc :form form :frame frame))
             (funcall res frame))))))
               (debug-signal 'frame-function-mismatch
                             :code-location loc :form form :frame frame))
             (funcall res frame))))))
-
-(defun eval-in-frame (frame form)
-  (declare (type frame frame))
-  #!+sb-doc
-  "Evaluate Form in the lexical context of Frame's current code location,
-   returning the results of the evaluation."
-  (funcall (preprocess-for-eval form (frame-code-location frame)) frame))
  \f
  ;;;; breakpoints
  
  ;;;; user-visible interface
  
  \f
  ;;;; breakpoints
  
  ;;;; user-visible interface
  
+;;; Create and return a breakpoint. When program execution encounters
+;;; the breakpoint, the system calls HOOK-FUNCTION. HOOK-FUNCTION takes the
+;;; current frame for the function in which the program is running and the
+;;; breakpoint object.
+;;;
+;;; WHAT and KIND determine where in a function the system invokes
+;;; HOOK-FUNCTION. WHAT is either a code-location or a debug-function.
+;;; KIND is one of :CODE-LOCATION, :FUNCTION-START, or :FUNCTION-END.
+;;; Since the starts and ends of functions may not have code-locations
+;;; representing them, designate these places by supplying WHAT as a
+;;; debug-function and KIND indicating the :FUNCTION-START or
+;;; :FUNCTION-END. When WHAT is a debug-function and kind is
+;;; :FUNCTION-END, then hook-function must take two additional
+;;; arguments, a list of values returned by the function and a
+;;; FUNCTION-END-COOKIE.
+;;;
+;;; INFO is information supplied by and used by the user.
+;;;
+;;; FUNCTION-END-COOKIE is a function. To implement :FUNCTION-END
+;;; breakpoints, the system uses starter breakpoints to establish the
+;;; :FUNCTION-END breakpoint for each invocation of the function. Upon
+;;; each entry, the system creates a unique cookie to identify the
+;;; invocation, and when the user supplies a function for this
+;;; argument, the system invokes it on the frame and the cookie. The
+;;; system later invokes the :FUNCTION-END breakpoint hook on the same
+;;; cookie. The user may save the cookie for comparison in the hook
+;;; function.
+;;;
+;;; Signal an error if WHAT is an unknown code-location.
  (defun make-breakpoint (hook-function what
                         &key (kind :code-location) info function-end-cookie)
  (defun make-breakpoint (hook-function what
                         &key (kind :code-location) info function-end-cookie)
-  #!+sb-doc
-  "This creates and returns a breakpoint. When program execution encounters
-   the breakpoint, the system calls hook-function. Hook-function takes the
-   current frame for the function in which the program is running and the
-   breakpoint object.
-      What and kind determine where in a function the system invokes
-   hook-function. What is either a code-location or a debug-function. Kind is
-   one of :code-location, :function-start, or :function-end. Since the starts
-   and ends of functions may not have code-locations representing them,
-   designate these places by supplying what as a debug-function and kind
-   indicating the :function-start or :function-end. When what is a
-   debug-function and kind is :function-end, then hook-function must take two
-   additional arguments, a list of values returned by the function and a
-   function-end-cookie.
-      Info is information supplied by and used by the user.
-      Function-end-cookie is a function. To implement :function-end breakpoints,
-   the system uses starter breakpoints to establish the :function-end breakpoint
-   for each invocation of the function. Upon each entry, the system creates a
-   unique cookie to identify the invocation, and when the user supplies a
-   function for this argument, the system invokes it on the frame and the
-   cookie. The system later invokes the :function-end breakpoint hook on the
-   same cookie. The user may save the cookie for comparison in the hook
-   function.
-      This signals an error if what is an unknown code-location."
    (etypecase what
      (code-location
       (when (code-location-unknown-p what)
         (error "cannot make a breakpoint at an unknown code location: ~S"
               what))
    (etypecase what
      (code-location
       (when (code-location-unknown-p what)
         (error "cannot make a breakpoint at an unknown code location: ~S"
               what))
-     (assert (eq kind :code-location))
+     (aver (eq kind :code-location))
       (let ((bpt (%make-breakpoint hook-function what kind info)))
         (etypecase what
       (let ((bpt (%make-breakpoint hook-function what kind info)))
         (etypecase what
-        (interpreted-code-location
-         (error "Breakpoints in interpreted code are currently unsupported."))
          (compiled-code-location
           ;; This slot is filled in due to calling CODE-LOCATION-UNKNOWN-P.
           (when (eq (compiled-code-location-kind what) :unknown-return)
          (compiled-code-location
           ;; This slot is filled in due to calling CODE-LOCATION-UNKNOWN-P.
           (when (eq (compiled-code-location-kind what) :unknown-return)
@@ -3171,7 +2906,11 @@
                                                :unknown-return-partner
                                                info)))
               (setf (breakpoint-unknown-return-partner bpt) other-bpt)
                                                :unknown-return-partner
                                                info)))
               (setf (breakpoint-unknown-return-partner bpt) other-bpt)
-             (setf (breakpoint-unknown-return-partner other-bpt) bpt)))))
+             (setf (breakpoint-unknown-return-partner other-bpt) bpt))))
+        ;; (There used to be more cases back before sbcl-0.7.0,,
+        ;; when we did special tricks to debug the IR1
+        ;; interpreter.)
+        )
         bpt))
      (compiled-debug-function
       (ecase kind
         bpt))
      (compiled-debug-function
       (ecase kind
@@ -3194,10 +2933,7 @@
           (setf (breakpoint-start-helper bpt) starter)
           (push bpt (breakpoint-%info starter))
           (setf (breakpoint-cookie-fun bpt) function-end-cookie)
           (setf (breakpoint-start-helper bpt) starter)
           (push bpt (breakpoint-%info starter))
           (setf (breakpoint-cookie-fun bpt) function-end-cookie)
-         bpt))))
-    (interpreted-debug-function
-     (error ":function-end breakpoints are currently unsupported ~
-            for interpreted-debug-functions."))))
+         bpt))))))
  
  ;;; These are unique objects created upon entry into a function by a
  ;;; :FUNCTION-END breakpoint's starter hook. These are only created
  
  ;;; These are unique objects created upon entry into a function by a
  ;;; :FUNCTION-END breakpoint's starter hook. These are only created
@@ -3207,13 +2943,14 @@
  (defstruct (function-end-cookie
             (:print-object (lambda (obj str)
                              (print-unreadable-object (obj str :type t))))
  (defstruct (function-end-cookie
             (:print-object (lambda (obj str)
                              (print-unreadable-object (obj str :type t))))
-           (:constructor make-function-end-cookie (bogus-lra debug-fun)))
-  ;; This is a pointer to the bogus-lra created for :function-end bpts.
+           (:constructor make-function-end-cookie (bogus-lra debug-fun))
+           (:copier nil))
+  ;; a pointer to the bogus-lra created for :FUNCTION-END breakpoints
    bogus-lra
    bogus-lra
-  ;; This is the debug-function associated with the cookie.
+  ;; the debug-function associated with the cookie
    debug-fun)
  
    debug-fun)
  
-;;; This maps bogus-lra-components to cookies, so
+;;; This maps bogus-lra-components to cookies, so that
  ;;; HANDLE-FUNCTION-END-BREAKPOINT can find the appropriate cookie for the
  ;;; breakpoint hook.
  (defvar *function-end-cookies* (make-hash-table :test 'eq))
  ;;; HANDLE-FUNCTION-END-BREAKPOINT can find the appropriate cookie for the
  ;;; breakpoint hook.
  (defvar *function-end-cookies* (make-hash-table :test 'eq))
@@ -3237,12 +2974,10 @@
         (multiple-value-bind (lra component offset)
             (make-bogus-lra
              (get-context-value frame
         (multiple-value-bind (lra component offset)
             (make-bogus-lra
              (get-context-value frame
-                               #!-gengc sb!vm::lra-save-offset
-                               #!+gengc sb!vm::ra-save-offset
+                               sb!vm::lra-save-offset
                                 lra-sc-offset))
           (setf (get-context-value frame
                                 lra-sc-offset))
           (setf (get-context-value frame
-                                  #!-gengc sb!vm::lra-save-offset
-                                  #!+gengc sb!vm::ra-save-offset
+                                  sb!vm::lra-save-offset
                                    lra-sc-offset)
                 lra)
           (let ((end-bpts (breakpoint-%info starter-bpt)))
                                    lra-sc-offset)
                 lra)
           (let ((end-bpts (breakpoint-%info starter-bpt)))
@@ -3256,16 +2991,17 @@
                 (let ((fun (breakpoint-cookie-fun bpt)))
                   (when fun (funcall fun frame cookie))))))))))
  
                 (let ((fun (breakpoint-cookie-fun bpt)))
                   (when fun (funcall fun frame cookie))))))))))
  
+;;; This takes a FUNCTION-END-COOKIE and a frame, and it returns
+;;; whether the cookie is still valid. A cookie becomes invalid when
+;;; the frame that established the cookie has exited. Sometimes cookie
+;;; holders are unaware of cookie invalidation because their
+;;; :FUNCTION-END breakpoint hooks didn't run due to THROW'ing.
+;;;
+;;; This takes a frame as an efficiency hack since the user probably
+;;; has a frame object in hand when using this routine, and it saves
+;;; repeated parsing of the stack and consing when asking whether a
+;;; series of cookies is valid.
  (defun function-end-cookie-valid-p (frame cookie)
  (defun function-end-cookie-valid-p (frame cookie)
-  #!+sb-doc
-  "This takes a function-end-cookie and a frame, and it returns whether the
-   cookie is still valid. A cookie becomes invalid when the frame that
-   established the cookie has exited. Sometimes cookie holders are unaware
-   of cookie invalidation because their :function-end breakpoint hooks didn't
-   run due to THROW'ing. This takes a frame as an efficiency hack since the
-   user probably has a frame object in hand when using this routine, and it
-   saves repeated parsing of the stack and consing when asking whether a
-   series of cookies is valid."
    (let ((lra (function-end-cookie-bogus-lra cookie))
         (lra-sc-offset (sb!c::compiled-debug-function-return-pc
                         (compiled-debug-function-compiler-debug-fun
    (let ((lra (function-end-cookie-bogus-lra cookie))
         (lra-sc-offset (sb!c::compiled-debug-function-return-pc
                         (compiled-debug-function-compiler-debug-fun
@@ -3275,18 +3011,17 @@
        (when (and (compiled-frame-p frame)
                  (eq lra
                      (get-context-value frame
        (when (and (compiled-frame-p frame)
                  (eq lra
                      (get-context-value frame
-                                       #!-gengc sb!vm::lra-save-offset
-                                       #!+gengc sb!vm::ra-save-offset
+                                       sb!vm::lra-save-offset
                                         lra-sc-offset)))
         (return t)))))
                                         lra-sc-offset)))
         (return t)))))
-
+\f
  ;;;; ACTIVATE-BREAKPOINT
  
  ;;;; ACTIVATE-BREAKPOINT
  
+;;; Cause the system to invoke the breakpoint's hook-function until
+;;; the next call to DEACTIVATE-BREAKPOINT or DELETE-BREAKPOINT. The
+;;; system invokes breakpoint hook functions in the opposite order
+;;; that you activate them.
  (defun activate-breakpoint (breakpoint)
  (defun activate-breakpoint (breakpoint)
-  #!+sb-doc
-  "This causes the system to invoke the breakpoint's hook-function until the
-   next call to DEACTIVATE-BREAKPOINT or DELETE-BREAKPOINT. The system invokes
-   breakpoint hook functions in the opposite order that you activate them."
    (when (eq (breakpoint-status breakpoint) :deleted)
      (error "cannot activate a deleted breakpoint: ~S" breakpoint))
    (unless (eq (breakpoint-status breakpoint) :active)
    (when (eq (breakpoint-status breakpoint) :deleted)
      (error "cannot activate a deleted breakpoint: ~S" breakpoint))
    (unless (eq (breakpoint-status breakpoint) :active)
@@ -3294,31 +3029,32 @@
        (:code-location
         (let ((loc (breakpoint-what breakpoint)))
          (etypecase loc
        (:code-location
         (let ((loc (breakpoint-what breakpoint)))
          (etypecase loc
-          (interpreted-code-location
-           (error "Breakpoints in interpreted code are currently unsupported."))
            (compiled-code-location
             (activate-compiled-code-location-breakpoint breakpoint)
             (let ((other (breakpoint-unknown-return-partner breakpoint)))
               (when other
            (compiled-code-location
             (activate-compiled-code-location-breakpoint breakpoint)
             (let ((other (breakpoint-unknown-return-partner breakpoint)))
               (when other
-               (activate-compiled-code-location-breakpoint other)))))))
+               (activate-compiled-code-location-breakpoint other))))
+          ;; (There used to be more cases back before sbcl-0.7.0, when
+          ;; we did special tricks to debug the IR1 interpreter.)
+          )))
        (:function-start
         (etypecase (breakpoint-what breakpoint)
          (compiled-debug-function
           (activate-compiled-function-start-breakpoint breakpoint))
        (:function-start
         (etypecase (breakpoint-what breakpoint)
          (compiled-debug-function
           (activate-compiled-function-start-breakpoint breakpoint))
-        (interpreted-debug-function
-         (error "I don't know how you made this, but they're unsupported: ~S"
-                (breakpoint-what breakpoint)))))
+        ;; (There used to be more cases back before sbcl-0.7.0, when
+        ;; we did special tricks to debug the IR1 interpreter.)
+        ))
        (:function-end
         (etypecase (breakpoint-what breakpoint)
          (compiled-debug-function
           (let ((starter (breakpoint-start-helper breakpoint)))
             (unless (eq (breakpoint-status starter) :active)
        (:function-end
         (etypecase (breakpoint-what breakpoint)
          (compiled-debug-function
           (let ((starter (breakpoint-start-helper breakpoint)))
             (unless (eq (breakpoint-status starter) :active)
-             ;; May already be active by some other :function-end breakpoint.
+             ;; may already be active by some other :FUNCTION-END breakpoint
               (activate-compiled-function-start-breakpoint starter)))
           (setf (breakpoint-status breakpoint) :active))
               (activate-compiled-function-start-breakpoint starter)))
           (setf (breakpoint-status breakpoint) :active))
-        (interpreted-debug-function
-         (error "I don't know how you made this, but they're unsupported: ~S"
-                (breakpoint-what breakpoint)))))))
+        ;; (There used to be more cases back before sbcl-0.7.0, when
+        ;; we did special tricks to debug the IR1 interpreter.)
+        ))))
    breakpoint)
  
  (defun activate-compiled-code-location-breakpoint (breakpoint)
    breakpoint)
  
  (defun activate-compiled-code-location-breakpoint (breakpoint)
@@ -3361,24 +3097,23 @@
     (setf (breakpoint-data-breakpoints data)
          (append (breakpoint-data-breakpoints data) (list breakpoint)))
     (setf (breakpoint-internal-data breakpoint) data)))
     (setf (breakpoint-data-breakpoints data)
          (append (breakpoint-data-breakpoints data) (list breakpoint)))
     (setf (breakpoint-internal-data breakpoint) data)))
-
+\f
  ;;;; DEACTIVATE-BREAKPOINT
  
  ;;;; DEACTIVATE-BREAKPOINT
  
+;;; Stop the system from invoking the breakpoint's hook-function.
  (defun deactivate-breakpoint (breakpoint)
  (defun deactivate-breakpoint (breakpoint)
-  #!+sb-doc
-  "This stops the system from invoking the breakpoint's hook-function."
    (when (eq (breakpoint-status breakpoint) :active)
      (without-interrupts
       (let ((loc (breakpoint-what breakpoint)))
         (etypecase loc
    (when (eq (breakpoint-status breakpoint) :active)
      (without-interrupts
       (let ((loc (breakpoint-what breakpoint)))
         (etypecase loc
-        ((or interpreted-code-location interpreted-debug-function)
-         (error
-          "Breakpoints in interpreted code are currently unsupported."))
          ((or compiled-code-location compiled-debug-function)
           (deactivate-compiled-breakpoint breakpoint)
           (let ((other (breakpoint-unknown-return-partner breakpoint)))
             (when other
          ((or compiled-code-location compiled-debug-function)
           (deactivate-compiled-breakpoint breakpoint)
           (let ((other (breakpoint-unknown-return-partner breakpoint)))
             (when other
-             (deactivate-compiled-breakpoint other))))))))
+             (deactivate-compiled-breakpoint other))))
+        ;; (There used to be more cases back before sbcl-0.7.0, when
+        ;; we did special tricks to debug the IR1 interpreter.)
+        ))))
    breakpoint)
  
  (defun deactivate-compiled-breakpoint (breakpoint)
    breakpoint)
  
  (defun deactivate-compiled-breakpoint (breakpoint)
@@ -3402,34 +3137,30 @@
           (delete-breakpoint-data data))))
    (setf (breakpoint-status breakpoint) :inactive)
    breakpoint)
           (delete-breakpoint-data data))))
    (setf (breakpoint-status breakpoint) :inactive)
    breakpoint)
-
+\f
  ;;;; BREAKPOINT-INFO
  
  ;;;; BREAKPOINT-INFO
  
+;;; Return the user-maintained info associated with breakpoint. This
+;;; is SETF'able.
  (defun breakpoint-info (breakpoint)
  (defun breakpoint-info (breakpoint)
-  #!+sb-doc
-  "This returns the user-maintained info associated with breakpoint. This
-   is SETF'able."
    (breakpoint-%info breakpoint))
  (defun %set-breakpoint-info (breakpoint value)
    (setf (breakpoint-%info breakpoint) value)
    (let ((other (breakpoint-unknown-return-partner breakpoint)))
      (when other
        (setf (breakpoint-%info other) value))))
    (breakpoint-%info breakpoint))
  (defun %set-breakpoint-info (breakpoint value)
    (setf (breakpoint-%info breakpoint) value)
    (let ((other (breakpoint-unknown-return-partner breakpoint)))
      (when other
        (setf (breakpoint-%info other) value))))
-
+\f
  ;;;; BREAKPOINT-ACTIVE-P and DELETE-BREAKPOINT
  
  (defun breakpoint-active-p (breakpoint)
  ;;;; BREAKPOINT-ACTIVE-P and DELETE-BREAKPOINT
  
  (defun breakpoint-active-p (breakpoint)
-  #!+sb-doc
-  "This returns whether breakpoint is currently active."
    (ecase (breakpoint-status breakpoint)
      (:active t)
      ((:inactive :deleted) nil)))
  
    (ecase (breakpoint-status breakpoint)
      (:active t)
      ((:inactive :deleted) nil)))
  
+;;; Free system storage and remove computational overhead associated
+;;; with breakpoint. After calling this, breakpoint is completely
+;;; impotent and can never become active again.
  (defun delete-breakpoint (breakpoint)
  (defun delete-breakpoint (breakpoint)
-  #!+sb-doc
-  "This frees system storage and removes computational overhead associated with
-   breakpoint. After calling this, breakpoint is completely impotent and can
-   never become active again."
    (let ((status (breakpoint-status breakpoint)))
      (unless (eq status :deleted)
        (when (eq status :active)
    (let ((status (breakpoint-status breakpoint)))
      (unless (eq status :deleted)
        (when (eq status :active)
@@ -3449,7 +3180,7 @@
                    (breakpoint-what breakpoint))
                   nil))))))
    breakpoint)
                    (breakpoint-what breakpoint))
                   nil))))))
    breakpoint)
-
+\f
  ;;;; C call out stubs
  
  ;;; This actually installs the break instruction in the component. It
  ;;;; C call out stubs
  
  ;;; This actually installs the break instruction in the component. It
@@ -3557,8 +3288,10 @@
        ;; so we just leave it up to the C code.
        (breakpoint-do-displaced-inst signal-context
                                     (breakpoint-data-instruction data))
        ;; so we just leave it up to the C code.
        (breakpoint-do-displaced-inst signal-context
                                     (breakpoint-data-instruction data))
-      ; Under HPUX we can't sigreturn so bp-do-disp-i has to return.
-      #!-(or hpux irix x86)
+      ;; Some platforms have no usable sigreturn() call.  If your
+      ;; implementation of arch_do_displaced_inst() doesn't sigreturn(),
+      ;; add it to this list.
+      #!-(or hpux irix x86 alpha)
        (error "BREAKPOINT-DO-DISPLACED-INST returned?"))))
  
  (defun invoke-breakpoint-hooks (breakpoints component offset)
        (error "BREAKPOINT-DO-DISPLACED-INST returned?"))))
  
  (defun invoke-breakpoint-hooks (breakpoints component offset)
@@ -3585,7 +3318,7 @@
               offset))
      (let ((breakpoints (breakpoint-data-breakpoints data)))
        (when breakpoints
               offset))
      (let ((breakpoints (breakpoint-data-breakpoints data)))
        (when breakpoints
-       (assert (eq (breakpoint-kind (car breakpoints)) :function-end))
+       (aver (eq (breakpoint-kind (car breakpoints)) :function-end))
         (handle-function-end-breakpoint-aux breakpoints data context)))))
  
  ;;; Either HANDLE-BREAKPOINT calls this for :FUNCTION-END breakpoints
         (handle-function-end-breakpoint-aux breakpoints data context)))))
  
  ;;; Either HANDLE-BREAKPOINT calls this for :FUNCTION-END breakpoints
@@ -3618,7 +3351,7 @@
                         #!+x86 sb!vm::ebx-offset)))
         (nargs (make-lisp-obj
                 (sb!vm:context-register scp sb!vm::nargs-offset)))
                         #!+x86 sb!vm::ebx-offset)))
         (nargs (make-lisp-obj
                 (sb!vm:context-register scp sb!vm::nargs-offset)))
-       (reg-arg-offsets '#.sb!vm::register-arg-offsets)
+       (reg-arg-offsets '#.sb!vm::*register-arg-offsets*)
         (results nil))
      (without-gcing
       (dotimes (arg-num nargs)
         (results nil))
      (without-gcing
       (dotimes (arg-num nargs)
@@ -3628,26 +3361,20 @@
                (stack-ref ocfp arg-num))
              results)))
      (nreverse results)))
                (stack-ref ocfp arg-num))
              results)))
      (nreverse results)))
+\f
+;;;; MAKE-BOGUS-LRA (used for :FUNCTION-END breakpoints)
  
  
-;;;; MAKE-BOGUS-LRA (used for :function-end breakpoints)
-
-(defconstant
-  bogus-lra-constants
+(defconstant bogus-lra-constants
    #!-x86 2 #!+x86 3)
    #!-x86 2 #!+x86 3)
-(defconstant
-  known-return-p-slot
+(defconstant known-return-p-slot
    (+ sb!vm:code-constants-offset #!-x86 1 #!+x86 2))
  
    (+ sb!vm:code-constants-offset #!-x86 1 #!+x86 2))
  
-;;; FIXME: This is also defined in debug-vm.lisp. Which definition
-;;; takes precedence? (One definition uses ALLOCATE-CODE-OBJECT, and
-;;; the other has been hacked for X86 GENCGC to use
-;;; ALLOCATE-DYNAMIC-CODE-OBJECT..)
+;;; Make a bogus LRA object that signals a breakpoint trap when
+;;; returned to. If the breakpoint trap handler returns, REAL-LRA is
+;;; returned to. Three values are returned: the bogus LRA object, the
+;;; code component it is part of, and the PC offset for the trap
+;;; instruction.
  (defun make-bogus-lra (real-lra &optional known-return-p)
  (defun make-bogus-lra (real-lra &optional known-return-p)
-  #!+sb-doc
-  "Make a bogus LRA object that signals a breakpoint trap when returned to. If
-   the breakpoint trap handler returns, REAL-LRA is returned to. Three values
-   are returned: the bogus LRA object, the code component it is part of, and
-   the PC offset for the trap instruction."
    (without-gcing
     (let* ((src-start (foreign-symbol-address "function_end_breakpoint_guts"))
           (src-end (foreign-symbol-address "function_end_breakpoint_end"))
    (without-gcing
     (let* ((src-start (foreign-symbol-address "function_end_breakpoint_guts"))
           (src-end (foreign-symbol-address "function_end_breakpoint_end"))
@@ -3690,15 +3417,14 @@
  \f
  ;;;; miscellaneous
  
  \f
  ;;;; miscellaneous
  
-;;; This appears here because it cannot go with the debug-function
+;;; This appears here because it cannot go with the DEBUG-FUNCTION
  ;;; interface since DO-DEBUG-BLOCK-LOCATIONS isn't defined until after
  ;;; interface since DO-DEBUG-BLOCK-LOCATIONS isn't defined until after
-;;; the debug-function routines.
+;;; the DEBUG-FUNCTION routines.
  
  
+;;; Return a code-location before the body of a function and after all
+;;; the arguments are in place; or if that location can't be
+;;; determined due to a lack of debug information, return NIL.
  (defun debug-function-start-location (debug-fun)
  (defun debug-function-start-location (debug-fun)
-  #!+sb-doc
-  "This returns a code-location before the body of a function and after all
-   the arguments are in place. If this cannot determine that location due to
-   a lack of debug information, it returns nil."
    (etypecase debug-fun
      (compiled-debug-function
       (code-location-from-pc debug-fun
    (etypecase debug-fun
      (compiled-debug-function
       (code-location-from-pc debug-fun
@@ -3706,14 +3432,9 @@
                              (compiled-debug-function-compiler-debug-fun
                               debug-fun))
                             nil))
                              (compiled-debug-function-compiler-debug-fun
                               debug-fun))
                             nil))
-    (interpreted-debug-function
-     ;; Return the first location if there are any, otherwise NIL.
-     (handler-case (do-debug-function-blocks (block debug-fun nil)
-                    (do-debug-block-locations (loc block nil)
-                      (return-from debug-function-start-location loc)))
-       (no-debug-blocks (condx)
-        (declare (ignore condx))
-        nil)))))
+    ;; (There used to be more cases back before sbcl-0.7.0, when
+    ;; we did special tricks to debug the IR1 interpreter.)
+    ))
  
  (defun print-code-locations (function)
    (let ((debug-fun (function-debug-function function)))
  
  (defun print-code-locations (function)
    (let ((debug-fun (function-debug-function function)))