0.pre7.88:

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

diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index b06b89c..2362e87 100644 (file)
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -12,9 +12,6 @@
 
 (in-package "SB!DI")
 
 
 (in-package "SB!DI")
 

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

 ;;; FIXME: There are an awful lot of package prefixes in this code.
 ;;; Couldn't we have SB-DI use the SB-C and SB-VM packages?
 \f
 ;;; FIXME: There are an awful lot of package prefixes in this code.
 ;;; Couldn't we have SB-DI use the SB-C and SB-VM packages?
 \f

@@ -41,28 +38,30 @@
   ()
   #!+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))
+(define-condition no-debug-fun-returns (debug-condition)
+  ((debug-fun :reader no-debug-fun-returns-debug-fun
+             :initarg :debug-fun))

   #!+sb-doc
   (:documentation
   #!+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-FUN since

     it lacked information about returning values.")
   (:report (lambda (condition stream)
     it lacked information about returning values.")
   (:report (lambda (condition stream)

-            (let ((fun (debug-function-function
-                        (no-debug-function-returns-debug-function condition))))
+            (let ((fun (debug-fun-fun
+                        (no-debug-fun-returns-debug-fun condition))))

               (format stream
                       "~&Cannot return values from ~:[frame~;~:*~S~] since ~
                        the debug information lacks details about returning ~
               (format stream
                       "~&Cannot return values from ~:[frame~;~:*~S~] since ~
                        the debug information lacks details about returning ~

@@ -70,33 +69,33 @@
                       fun)))))
 
 (define-condition no-debug-blocks (debug-condition)
                       fun)))))
 
 (define-condition no-debug-blocks (debug-condition)

-  ((debug-function :reader no-debug-blocks-debug-function
-                  :initarg :debug-function))
+  ((debug-fun :reader no-debug-blocks-debug-fun
+             :initarg :debug-fun))

   #!+sb-doc
   #!+sb-doc

-  (:documentation "The debug-function has no debug-block information.")
+  (:documentation "The debug-fun has no debug-block information.")

   (:report (lambda (condition stream)
             (format stream "~&~S has no debug-block information."
   (:report (lambda (condition stream)
             (format stream "~&~S has no debug-block information."

-                    (no-debug-blocks-debug-function condition)))))
+                    (no-debug-blocks-debug-fun condition)))))

 
 (define-condition no-debug-vars (debug-condition)
 
 (define-condition no-debug-vars (debug-condition)

-  ((debug-function :reader no-debug-vars-debug-function
-                  :initarg :debug-function))
+  ((debug-fun :reader no-debug-vars-debug-fun
+             :initarg :debug-fun))

   #!+sb-doc
   #!+sb-doc

-  (:documentation "The debug-function has no DEBUG-VAR information.")
+  (:documentation "The DEBUG-FUN has no DEBUG-VAR information.")

   (:report (lambda (condition stream)
             (format stream "~&~S has no debug variable information."
   (:report (lambda (condition stream)
             (format stream "~&~S has no debug variable information."

-                    (no-debug-vars-debug-function condition)))))
+                    (no-debug-vars-debug-fun condition)))))

 
 (define-condition lambda-list-unavailable (debug-condition)
 
 (define-condition lambda-list-unavailable (debug-condition)

-  ((debug-function :reader lambda-list-unavailable-debug-function
-                  :initarg :debug-function))
+  ((debug-fun :reader lambda-list-unavailable-debug-fun
+             :initarg :debug-fun))

   #!+sb-doc
   (:documentation
   #!+sb-doc
   (:documentation

-   "The debug-function has no lambda-list since argument DEBUG-VARs are
+   "The DEBUG-FUN has no lambda list since argument DEBUG-VARs are

     unavailable.")
   (:report (lambda (condition stream)
             (format stream "~&~S has no lambda-list information available."
     unavailable.")
   (:report (lambda (condition stream)
             (format stream "~&~S has no lambda-list information available."

-                    (lambda-list-unavailable-debug-function condition)))))
+                    (lambda-list-unavailable-debug-fun condition)))))

 
 (define-condition invalid-value (debug-condition)
   ((debug-var :reader invalid-value-debug-var :initarg :debug-var)
 
 (define-condition invalid-value (debug-condition)
   ((debug-var :reader invalid-value-debug-var :initarg :debug-var)

@@ -106,13 +105,13 @@
                     (invalid-value-debug-var condition)
                     (invalid-value-frame condition)))))
 
                     (invalid-value-debug-var condition)
                     (invalid-value-frame condition)))))
 

-(define-condition ambiguous-variable-name (debug-condition)
-  ((name :reader ambiguous-variable-name-name :initarg :name)
-   (frame :reader ambiguous-variable-name-frame :initarg :frame))
+(define-condition ambiguous-var-name (debug-condition)
+  ((name :reader ambiguous-var-name-name :initarg :name)
+   (frame :reader ambiguous-var-name-frame :initarg :frame))

   (:report (lambda (condition stream)
             (format stream "~&~S names more than one valid variable in ~S."
   (:report (lambda (condition stream)
             (format stream "~&~S names more than one valid variable in ~S."

-                    (ambiguous-variable-name-name condition)
-                    (ambiguous-variable-name-frame condition)))))
+                    (ambiguous-var-name-name condition)
+                    (ambiguous-var-name-frame condition)))))

 \f
 ;;;; errors and DEBUG-SIGNAL
 
 \f
 ;;;; errors and DEBUG-SIGNAL
 

@@ -130,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

@@ -145,12 +144,12 @@
 
 (define-condition unknown-debug-var (debug-error)
   ((debug-var :reader unknown-debug-var-debug-var :initarg :debug-var)
 
 (define-condition unknown-debug-var (debug-error)
   ((debug-var :reader unknown-debug-var-debug-var :initarg :debug-var)

-   (debug-function :reader unknown-debug-var-debug-function
-                  :initarg :debug-function))
+   (debug-fun :reader unknown-debug-var-debug-fun
+             :initarg :debug-fun))

   (:report (lambda (condition stream)
             (format stream "~&~S is not in ~S."
                     (unknown-debug-var-debug-var condition)
   (:report (lambda (condition stream)
             (format stream "~&~S is not in ~S."
                     (unknown-debug-var-debug-var condition)

-                    (unknown-debug-var-debug-function condition)))))
+                    (unknown-debug-var-debug-fun condition)))))

 
 (define-condition invalid-control-stack-pointer (debug-error)
   ()
 
 (define-condition invalid-control-stack-pointer (debug-error)
   ()

@@ -159,26 +158,27 @@
             (fresh-line stream)
             (write-string "invalid control stack pointer" stream))))
 
             (fresh-line stream)
             (write-string "invalid control stack pointer" stream))))
 

-(define-condition frame-function-mismatch (debug-error)
-  ((code-location :reader frame-function-mismatch-code-location
+(define-condition frame-fun-mismatch (debug-error)
+  ((code-location :reader frame-fun-mismatch-code-location

                  :initarg :code-location)
                  :initarg :code-location)

-   (frame :reader frame-function-mismatch-frame :initarg :frame)
-   (form :reader frame-function-mismatch-form :initarg :form))
+   (frame :reader frame-fun-mismatch-frame :initarg :frame)
+   (form :reader frame-fun-mismatch-form :initarg :form))

   (:report (lambda (condition stream)
   (: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-fun-mismatch-code-location condition)
+             (frame-fun-mismatch-frame condition)
+             (frame-fun-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
 ;;;;

@@ -186,51 +186,48 @@
 ;;;; 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
 
 ;;;; 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))
+;;; compiler DEBUG-FUNs.
+(defstruct (debug-var (:constructor nil)
+                     (:copier nil))

   ;; the name of the variable
   ;; the name of the variable

-  (symbol (required-argument) :type symbol)
+  (symbol (missing-arg) :type symbol)

   ;; a unique integer identification relative to other variables with the same
   ;; symbol
   ;; a unique integer identification relative to other variables with the same
   ;; symbol

-  (id 0 :type sb!c::index)
+  (id 0 :type index)

   ;; Does the variable always have a valid value?
   (alive-p nil :type boolean))
 (def!method print-object ((debug-var debug-var) stream)
   (print-unreadable-object (debug-var stream :type t :identity t)
     (format stream
   ;; Does the variable always have a valid value?
   (alive-p nil :type boolean))
 (def!method print-object ((debug-var debug-var) stream)
   (print-unreadable-object (debug-var stream :type t :identity t)
     (format stream

-           "~S ~D"
+           "~S ~W"

            (debug-var-symbol debug-var)
            (debug-var-id debug-var))))
 
 #!+sb-doc
 (setf (fdocumentation 'debug-var-id 'function)
            (debug-var-symbol debug-var)
            (debug-var-id debug-var))))
 
 #!+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)))
-  ;; 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))
+                         (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)))

 
 ;;;; frames
 
 
 ;;;; frames
 

-;;; These represent call-frames on the stack.
-(defstruct (frame (:constructor nil))
+;;; These represent call frames on the stack.
+(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

@@ -238,238 +235,152 @@
   ;; to the control stack for the given frame. This lets us get the
   ;; next frame down and the return-pc for that frame.
   (%down :unparsed :type (or frame (member nil :unparsed)))
   ;; to the control stack for the given frame. This lets us get the
   ;; next frame down and the return-pc for that frame.
   (%down :unparsed :type (or frame (member nil :unparsed)))

-  ;; the debug-function for the function whose call this frame
-  ;; represents
-  (debug-function nil :type debug-function)
-  ;; the code-location to continue upon return to frame
+  ;; the DEBUG-FUN for the function whose call this frame represents
+  (debug-fun nil :type debug-fun)
+  ;; the CODE-LOCATION where the frame's DEBUG-FUN will continue
+  ;; running when program execution returns to this frame. If someone
+  ;; interrupted this frame, the result could be an unknown
+  ;; CODE-LOCATION.

   (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))
 
   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
-   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.")
-
-#!+sb-doc
-(setf (fdocumentation 'frame-code-location 'function)
-  "Returns 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.")
-

 (defstruct (compiled-frame
            (:include frame)
            (:constructor make-compiled-frame
 (defstruct (compiled-frame
            (:include frame)
            (:constructor make-compiled-frame

-                         (pointer up debug-function code-location number
-                                  #!+gengc saved-state-chain
-                                  &optional escaped)))
+                         (pointer up debug-fun code-location number
+                                  &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~]"
 (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))
+           (debug-fun-name (frame-debug-fun obj))

            (compiled-frame-escaped 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)))
-
-;;;; DEBUG-FUNCTIONs
+\f
+;;;; DEBUG-FUNs

 
 ;;; These exist for caching data stored in packed binary form in
 
 ;;; These exist for caching data stored in packed binary form in

-;;; compiler debug-functions. *COMPILED-DEBUG-FUNCTIONS* maps a
-;;; SB!C::DEBUG-FUNCTION to a DEBUG-FUNCTION. There should only be one
-;;; DEBUG-FUNCTION in existence for any function; that is, all
-;;; 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
-  ;; DEBUG-FUNCTION-LAMBDA-LIST.
+;;; compiler DEBUG-FUNs. *COMPILED-DEBUG-FUNS* maps a SB!C::DEBUG-FUN
+;;; to a DEBUG-FUN. There should only be one DEBUG-FUN in existence
+;;; for any function; that is, all CODE-LOCATIONs and other objects
+;;; that reference DEBUG-FUNs point to unique objects. This is
+;;; due to the overhead in cached information.
+(defstruct (debug-fun (:constructor nil)
+                     (:copier nil))
+  ;; some representation of the function arguments. See
+  ;; DEBUG-FUN-LAMBDA-LIST.

   ;; NOTE: must parse vars before parsing arg list stuff.
   (%lambda-list :unparsed)
   ;; 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))))
   (%function :unparsed :type (or null function (member :unparsed))))

-(def!method print-object ((obj debug-function) stream)
+(def!method print-object ((obj debug-fun) stream)

   (print-unreadable-object (obj stream :type t)
   (print-unreadable-object (obj stream :type t)

-    (prin1 (debug-function-name obj) stream)))
-
-(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 nil :type sb!c::compiled-debug-function)
-  ;; Code object. (unexported).
+    (prin1 (debug-fun-name obj) stream)))
+
+(defstruct (compiled-debug-fun
+           (:include debug-fun)
+           (:constructor %make-compiled-debug-fun
+                         (compiler-debug-fun component))
+           (:copier nil))
+  ;; compiler's dumped DEBUG-FUN information (unexported)
+  (compiler-debug-fun nil :type sb!c::compiled-debug-fun)
+  ;; code object (unexported).

   component
   component

-  ;; The :FUNCTION-START breakpoint (if any) used to facilitate
-  ;; function end breakpoints.
+  ;; the :FUN-START breakpoint (if any) used to facilitate
+  ;; function end breakpoints

   (end-starter nil :type (or null breakpoint)))
 
   (end-starter nil :type (or null breakpoint)))
 

-;;; This maps SB!C::COMPILED-DEBUG-FUNCTIONs to
-;;; COMPILED-DEBUG-FUNCTIONs, so we can get at cached stuff and not
-;;; duplicate COMPILED-DEBUG-FUNCTION structures.
-(defvar *compiled-debug-functions* (make-hash-table :test 'eq))
+;;; This maps SB!C::COMPILED-DEBUG-FUNs to
+;;; COMPILED-DEBUG-FUNs, so we can get at cached stuff and not
+;;; duplicate COMPILED-DEBUG-FUN structures.
+(defvar *compiled-debug-funs* (make-hash-table :test 'eq))

 
 

-;;; Make a COMPILED-DEBUG-FUNCTION for a SB!C::COMPILER-DEBUG-FUNCTION
+;;; Make a COMPILED-DEBUG-FUN for a SB!C::COMPILER-DEBUG-FUN

 ;;; and its component. This maps the latter to the former in
 ;;; and its component. This maps the latter to the former in

-;;; *COMPILED-DEBUG-FUNCTIONS*. If there already is a
-;;; COMPILED-DEBUG-FUNCTION, then this returns it from
-;;; *COMPILED-DEBUG-FUNCTIONS*.
-(defun make-compiled-debug-function (compiler-debug-fun component)
-  (or (gethash compiler-debug-fun *compiled-debug-functions*)
-      (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)
-                                (blocks nil) (%function nil))))
+;;; *COMPILED-DEBUG-FUNS*. If there already is a
+;;; COMPILED-DEBUG-FUN, then this returns it from
+;;; *COMPILED-DEBUG-FUNS*.
+(defun make-compiled-debug-fun (compiler-debug-fun component)
+  (or (gethash compiler-debug-fun *compiled-debug-funs*)
+      (setf (gethash compiler-debug-fun *compiled-debug-funs*)
+           (%make-compiled-debug-fun compiler-debug-fun component))))
+
+(defstruct (bogus-debug-fun
+           (:include debug-fun)
+           (:constructor make-bogus-debug-fun
+                         (%name &aux
+                                (%lambda-list nil)
+                                (%debug-vars nil)
+                                (blocks nil)
+                                (%function nil)))
+           (:copier nil))

   %name)
 
   %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)))))
-
+(defvar *ir1-lambda-debug-fun* (make-hash-table :test 'eq))
+\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)

-    (prin1 (debug-block-function-name obj) str)))
+    (prin1 (debug-block-fun-name obj) str)))

 
 #!+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.

-  (offset nil :type sb!c::index)
+  (offset nil :type index)

   ;; The original instruction replaced by the breakpoint.
   (instruction nil :type (or null (unsigned-byte 32)))
   ;; A list of user breakpoints at this location.
   ;; The original instruction replaced by the breakpoint.
   (instruction nil :type (or null (unsigned-byte 32)))
   ;; A list of user breakpoints at this location.

@@ -477,26 +388,27 @@
 (def!method print-object ((obj breakpoint-data) str)
   (print-unreadable-object (obj str :type t)
     (format str "~S at ~S"
 (def!method print-object ((obj breakpoint-data) str)
   (print-unreadable-object (obj str :type t)
     (format str "~S at ~S"

-           (debug-function-name
-            (debug-function-from-pc (breakpoint-data-component obj)
-                                    (breakpoint-data-offset obj)))
+           (debug-fun-name
+            (debug-fun-from-pc (breakpoint-data-component obj)
+                               (breakpoint-data-offset obj)))

            (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
   ;; 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
+  ;; list of values. Values are supplied for :FUN-END breakpoints

   ;; as values to return for the function containing the breakpoint.
   ;; as values to return for the function containing the breakpoint.

-  ;; :FUNCTION-END breakpoint hook-functions also take a cookie
+  ;; :FUN-END breakpoint hook-functions also take a cookie

   ;; argument. See COOKIE-FUN slot.
   (hook-function nil :type function)
   ;; argument. See COOKIE-FUN slot.
   (hook-function nil :type function)

-  ;; CODE-LOCATION or DEBUG-FUNCTION
-  (what nil :type (or code-location debug-function))
-  ;; :CODE-LOCATION, :FUNCTION-START, or :FUNCTION-END for that kind
+  ;; CODE-LOCATION or DEBUG-FUN
+  (what nil :type (or code-location debug-fun))
+  ;; :CODE-LOCATION, :FUN-START, or :FUN-END for that kind

   ;; of breakpoint. :UNKNOWN-RETURN-PARTNER if this is the partner of
   ;; a :code-location breakpoint at an :UNKNOWN-RETURN code-location.
   ;; of breakpoint. :UNKNOWN-RETURN-PARTNER if this is the partner of
   ;; a :code-location breakpoint at an :UNKNOWN-RETURN code-location.

-  (kind nil :type (member :code-location :function-start :function-end
+  (kind nil :type (member :code-location :fun-start :fun-end

                          :unknown-return-partner))
   ;; Status helps the user and the implementation.
   (status :inactive :type (member :active :inactive :deleted))
                          :unknown-return-partner))
   ;; Status helps the user and the implementation.
   (status :inactive :type (member :active :inactive :deleted))

@@ -508,7 +420,7 @@
   ;; breakpoint for the other one, or NIL if this isn't at an
   ;; :UNKNOWN-RETURN code location.
   (unknown-return-partner nil :type (or null breakpoint))
   ;; breakpoint for the other one, or NIL if this isn't at an
   ;; :UNKNOWN-RETURN code location.
   (unknown-return-partner nil :type (or null breakpoint))

-  ;; :FUNCTION-END breakpoints use a breakpoint at the :FUNCTION-START
+  ;; :FUN-END breakpoints use a breakpoint at the :FUN-START

   ;; to establish the end breakpoint upon function entry. We do this
   ;; by frobbing the LRA to jump to a special piece of code that
   ;; breaks and provides the return values for the returnee. This slot
   ;; to establish the end breakpoint upon function entry. We do this
   ;; by frobbing the LRA to jump to a special piece of code that
   ;; breaks and provides the return values for the returnee. This slot

@@ -516,8 +428,8 @@
   ;; and delete it.
   (start-helper nil :type (or null breakpoint))
   ;; This is a hook users supply to get a dynamically unique cookie
   ;; and delete it.
   (start-helper nil :type (or null breakpoint))
   ;; This is a hook users supply to get a dynamically unique cookie

-  ;; for identifying :FUNCTION-END breakpoint executions. That is, if
-  ;; there is one :FUNCTION-END breakpoint, but there may be multiple
+  ;; for identifying :FUN-END breakpoint executions. That is, if
+  ;; there is one :FUN-END breakpoint, but there may be multiple

   ;; pending calls of its function on the stack. This function takes
   ;; the cookie, and the hook-function takes the cookie too.
   (cookie-fun nil :type (or null function))
   ;; pending calls of its function on the stack. This function takes
   ;; the cookie, and the hook-function takes the cookie too.
   (cookie-fun nil :type (or null function))

@@ -530,29 +442,17 @@
              "~S~:[~;~:*~S~]"
              (etypecase what
                (code-location what)
              "~S~:[~;~:*~S~]"
              (etypecase what
                (code-location what)

-               (debug-function (debug-function-name what)))
+               (debug-fun (debug-fun-name what)))

              (etypecase what
                (code-location nil)
              (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.")
-
+               (debug-fun (breakpoint-kind obj)))))))
+\f

 ;;;; CODE-LOCATIONs
 
 ;;;; CODE-LOCATIONs
 

-(defstruct (code-location (:constructor nil))
-  ;; This is the debug-function containing code-location.
-  (debug-function nil :type debug-function)
+(defstruct (code-location (:constructor nil)
+                         (:copier nil))
+  ;; the DEBUG-FUN containing this CODE-LOCATION
+  (debug-fun nil :type debug-fun)

   ;; This is initially :UNSURE. Upon first trying to access an
   ;; :unparsed slot, if the data is unavailable, then this becomes t,
   ;; and the code-location is unknown. If the data is available, this
   ;; This is initially :UNSURE. Upon first trying to access an
   ;; :unparsed slot, if the data is unavailable, then this becomes t,
   ;; and the code-location is unknown. If the data is available, this

@@ -562,100 +462,53 @@
   ;; parsing the stack, we don't want to unpack all the variables and
   ;; blocks just to make frames.
   (%unknown-p :unsure :type (member t nil :unsure))
   ;; parsing the stack, we don't want to unpack all the variables and
   ;; blocks just to make frames.
   (%unknown-p :unsure :type (member t nil :unsure))

-  ;; This is the debug-block containing code-location. Possibly toss
-  ;; this out and just find it in the blocks cache in debug-function.
+  ;; the DEBUG-BLOCK containing CODE-LOCATION. XXX Possibly toss this
+  ;; out and just find it in the blocks cache in DEBUG-FUN.

   (%debug-block :unparsed :type (or debug-block (member :unparsed)))
   ;; This is the number of forms processed by the compiler or loader
   (%debug-block :unparsed :type (or debug-block (member :unparsed)))
   ;; This is the number of forms processed by the compiler or loader

-  ;; before the top-level form containing this code-location.
-  (%tlf-offset :unparsed :type (or sb!c::index (member :unparsed)))
+  ;; before the top level form containing this code-location.
+  (%tlf-offset :unparsed :type (or index (member :unparsed)))

   ;; This is the depth-first number of the node that begins
   ;; This is the depth-first number of the node that begins

-  ;; code-location within its top-level form.
-  (%form-number :unparsed :type (or sb!c::index (member :unparsed))))
+  ;; code-location within its top level form.
+  (%form-number :unparsed :type (or index (member :unparsed))))

 (def!method print-object ((obj code-location) str)
   (print-unreadable-object (obj str :type t)
 (def!method print-object ((obj code-location) str)
   (print-unreadable-object (obj str :type t)

-    (prin1 (debug-function-name (code-location-debug-function obj))
+    (prin1 (debug-fun-name (code-location-debug-fun obj))

           str)))
 
           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
 (defstruct (compiled-code-location
            (:include code-location)
            (:constructor make-known-code-location

-                         (pc debug-function %tlf-offset %form-number
+                         (pc debug-fun %tlf-offset %form-number

                              %live-set kind &aux (%unknown-p nil)))
                              %live-set kind &aux (%unknown-p nil)))

-           (:constructor make-compiled-code-location (pc debug-function)))
-  ;; 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
-  ;; DEBUG-FUNCTION-DEBUG-VARS indicating whether the variable has a
+           (:constructor make-compiled-code-location (pc debug-fun))
+           (:copier nil))
+  ;; an index into DEBUG-FUN's component slot
+  (pc nil :type index)
+  ;; a bit-vector indexed by a variable's position in
+  ;; DEBUG-FUN-DEBUG-VARS indicating whether the variable has a

   ;; valid value at this code-location. (unexported).
   (%live-set :unparsed :type (or simple-bit-vector (member :unparsed)))
   ;; (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)))
   ;; valid value at this code-location. (unexported).
   (%live-set :unparsed :type (or simple-bit-vector (member :unparsed)))
   ;; (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
-;;; and LRAs used for :function-end breakpoints. When a components
-;;; debug-info slot is :bogus-lra, then the real-lra-slot contains the
+;;; This is used in FIND-ESCAPED-FRAME and with the bogus components
+;;; and LRAs used for :FUN-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
 ;;; component which appeared in some frame's LRA location.
 (defconstant real-lra-slot sb!vm:code-constants-offset)
 ;;; real component to continue executing, as opposed to the bogus
 ;;; component which appeared in some frame's LRA location.
 (defconstant real-lra-slot sb!vm:code-constants-offset)

@@ -665,38 +518,34 @@
 (defun current-fp () (current-fp))
 (defun stack-ref (s n) (stack-ref s n))
 (defun %set-stack-ref (s n value) (%set-stack-ref s n value))
 (defun current-fp () (current-fp))
 (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 fun-code-header (fun) (fun-code-header fun))
+(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 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 fun-word-offset (fun) (fun-word-offset fun))

 
 #!-sb-fluid (declaim (inline cstack-pointer-valid-p))
 (defun cstack-pointer-valid-p (x)
   (declare (type system-area-pointer x))
 
 #!-sb-fluid (declaim (inline cstack-pointer-valid-p))
 (defun cstack-pointer-valid-p (x)
   (declare (type system-area-pointer x))

-  #!-x86
+  #!-x86 ; stack grows toward high address values

   (and (sap< x (current-sp))
   (and (sap< x (current-sp))

-       (sap<= #!-gengc (sb!alien:alien-sap
-                       (sb!alien:extern-alien "control_stack" (* t)))
-             #!+gengc (mutator-control-stack-base)
+       (sap<= (int-sap control-stack-start)

              x)
        (zerop (logand (sap-int x) #b11)))
              x)
        (zerop (logand (sap-int x) #b11)))

-  #!+x86 ;; stack grows to low address values
+  #!+x86 ; stack grows toward low address values

   (and (sap>= x (current-sp))
   (and (sap>= x (current-sp))

-       (sap> (sb!alien:alien-sap (sb!alien:extern-alien "control_stack_end"
-                                                       (* t)))
-            x)
+       (sap> (int-sap control-stack-end) x)

        (zerop (logand (sap-int x) #b11))))
 
        (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)

-                        sb!vm:other-pointer-type)))
+                        sb!vm:other-pointer-lowtag)))

 
 ;;;; X86 support
 
 
 ;;;; X86 support
 

@@ -708,10 +557,10 @@
   (let ((component-ptr (component-ptr-from-pc pc)))
     (unless (sap= component-ptr (int-sap #x0))
        (let* ((code (component-from-component-ptr component-ptr))
   (let ((component-ptr (component-ptr-from-pc pc)))
     (unless (sap= component-ptr (int-sap #x0))
        (let* ((code (component-from-component-ptr component-ptr))

-             (code-header-len (* (get-header-data code) sb!vm:word-bytes))
+             (code-header-len (* (get-header-data code) sb!vm:n-word-bytes))

              (pc-offset (- (sap-int pc)
                            (- (get-lisp-obj-address code)
              (pc-offset (- (sap-int pc)
                            (- (get-lisp-obj-address code)

-                              sb!vm:other-pointer-type)
+                              sb!vm:other-pointer-lowtag)

                            code-header-len)))
 ;       (format t "c-lra-fpc ~A ~A ~A~%" pc code pc-offset)
         (values pc-offset code)))))
                            code-header-len)))
 ;       (format t "c-lra-fpc ~A ~A ~A~%" pc code pc-offset)
         (values pc-offset code)))))

@@ -729,9 +578,7 @@
    ;; Not the first page which is unmapped.
    (>= (sap-int ra) 4096)
    ;; Not a Lisp stack pointer.
    ;; Not the first page which is unmapped.
    (>= (sap-int ra) 4096)
    ;; Not a Lisp stack pointer.

-   (or (sap< ra (current-sp))
-       (sap>= ra (sb!alien:alien-sap
-                 (sb!alien:extern-alien "control_stack_end" (* t)))))))
+   (not (cstack-pointer-valid-p ra))))

 
 ;;; Try to find a valid previous stack. This is complex on the x86 as
 ;;; it can jump between C and Lisp frames. To help find a valid frame
 
 ;;; Try to find a valid previous stack. This is complex on the x86 as
 ;;; it can jump between C and Lisp frames. To help find a valid frame

@@ -740,9 +587,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)

@@ -752,11 +599,11 @@
     nil)
    (t
     ;; Check the two possible frame pointers.
     nil)
    (t
     ;; Check the two possible frame pointers.

-    (let ((lisp-ocfp (sap-ref-sap fp (- (* (1+ sb!vm::ocfp-save-offset) 4))))
-         (lisp-ra (sap-ref-sap fp (- (* (1+ sb!vm::return-pc-save-offset)
+    (let ((lisp-ocfp (sap-ref-sap fp (- (* (1+ ocfp-save-offset) 4))))
+         (lisp-ra (sap-ref-sap fp (- (* (1+ return-pc-save-offset)

                                         4))))
                                         4))))

-         (c-ocfp (sap-ref-sap fp (* 0 sb!vm:word-bytes)))
-         (c-ra (sap-ref-sap fp (* 1 sb!vm:word-bytes))))
+         (c-ocfp (sap-ref-sap fp (* 0 sb!vm:n-word-bytes)))
+         (c-ra (sap-ref-sap fp (* 1 sb!vm:n-word-bytes))))

       (cond ((and (sap> lisp-ocfp fp) (cstack-pointer-valid-p lisp-ocfp)
                  (ra-pointer-valid-p lisp-ra)
                  (sap> c-ocfp fp) (cstack-pointer-valid-p c-ocfp)
       (cond ((and (sap> lisp-ocfp fp) (cstack-pointer-valid-p lisp-ocfp)
                  (ra-pointer-valid-p lisp-ra)
                  (sap> c-ocfp fp) (cstack-pointer-valid-p c-ocfp)

@@ -766,15 +613,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)

@@ -811,61 +663,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."
+  (/noshow0 "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."
+  (/noshow0 "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-fun frame)))
+         (/noshow0 "in DOWN :UNPARSED case")

          (setf (frame-%down frame)
                (etypecase debug-fun
          (setf (frame-%down frame)
                (etypecase debug-fun

-                 (compiled-debug-function
-                  (let ((c-d-f (compiled-debug-function-compiler-debug-fun
+                 (compiled-debug-fun
+                  (let ((c-d-f (compiled-debug-fun-compiler-debug-fun

                                 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 ocfp-save-offset
+                       (sb!c::compiled-debug-fun-old-fp c-d-f)))
+                     (get-context-value
+                      frame lra-save-offset
+                      (sb!c::compiled-debug-fun-return-pc c-d-f))

                      frame)))
                      frame)))

-                 (bogus-debug-function
-                  (let ((fp (frame-pointer real)))
+                 (bogus-debug-fun
+                  (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)

@@ -873,18 +712,15 @@
                        #!-x86
                       (compute-calling-frame
                        #!-alpha
                        #!-x86
                       (compute-calling-frame
                        #!-alpha

-                       (sap-ref-sap fp (* sb!vm::ocfp-save-offset
-                                          sb!vm:word-bytes))
+                       (sap-ref-sap fp (* ocfp-save-offset
+                                          sb!vm:n-word-bytes))

                        #!+alpha
                        (int-sap
                        #!+alpha
                        (int-sap

-                        (sap-ref-32 fp (* sb!vm::ocfp-save-offset
-                                          sb!vm:word-bytes)))
-
-                       #!-gengc
-                       (stack-ref fp sb!vm::lra-save-offset)
-                       #!+gengc
-                       (sap-ref-sap fp (* sb!vm::ra-save-offset
-                                          sb!vm:word-bytes))
+                        (sap-ref-32 fp (* ocfp-save-offset
+                                          sb!vm:n-word-bytes)))
+
+                       (stack-ref fp lra-save-offset)
+

                        frame)))))))
        down)))
 
                        frame)))))))
        down)))
 

@@ -894,7 +730,7 @@
 #!-x86
 (defun get-context-value (frame stack-slot loc)
   (declare (type compiled-frame frame) (type unsigned-byte stack-slot)
 #!-x86
 (defun get-context-value (frame stack-slot loc)
   (declare (type compiled-frame frame) (type unsigned-byte stack-slot)

-          (type sb!c::sc-offset loc))
+          (type sb!c:sc-offset loc))

   (let ((pointer (frame-pointer frame))
        (escaped (compiled-frame-escaped frame)))
     (if escaped
   (let ((pointer (frame-pointer frame))
        (escaped (compiled-frame-escaped frame)))
     (if escaped

@@ -903,21 +739,21 @@
 #!+x86
 (defun get-context-value (frame stack-slot loc)
   (declare (type compiled-frame frame) (type unsigned-byte stack-slot)
 #!+x86
 (defun get-context-value (frame stack-slot loc)
   (declare (type compiled-frame frame) (type unsigned-byte stack-slot)

-          (type sb!c::sc-offset loc))
+          (type sb!c:sc-offset loc))

   (let ((pointer (frame-pointer frame))
        (escaped (compiled-frame-escaped frame)))
     (if escaped
        (sub-access-debug-var-slot pointer loc escaped)
        (ecase stack-slot
   (let ((pointer (frame-pointer frame))
        (escaped (compiled-frame-escaped frame)))
     (if escaped
        (sub-access-debug-var-slot pointer loc escaped)
        (ecase stack-slot

-         (#.sb!vm::ocfp-save-offset
+         (#.ocfp-save-offset

           (stack-ref pointer stack-slot))
           (stack-ref pointer stack-slot))

-         (#.sb!vm::lra-save-offset
+         (#.lra-save-offset

           (sap-ref-sap pointer (- (* (1+ stack-slot) 4))))))))
 
 #!-x86
 (defun (setf get-context-value) (value frame stack-slot loc)
   (declare (type compiled-frame frame) (type unsigned-byte stack-slot)
           (sap-ref-sap pointer (- (* (1+ stack-slot) 4))))))))
 
 #!-x86
 (defun (setf get-context-value) (value frame stack-slot loc)
   (declare (type compiled-frame frame) (type unsigned-byte stack-slot)

-          (type sb!c::sc-offset loc))
+          (type sb!c:sc-offset loc))

   (let ((pointer (frame-pointer frame))
        (escaped (compiled-frame-escaped frame)))
     (if escaped
   (let ((pointer (frame-pointer frame))
        (escaped (compiled-frame-escaped frame)))
     (if escaped

@@ -927,68 +763,22 @@
 #!+x86
 (defun (setf get-context-value) (value frame stack-slot loc)
   (declare (type compiled-frame frame) (type unsigned-byte stack-slot)
 #!+x86
 (defun (setf get-context-value) (value frame stack-slot loc)
   (declare (type compiled-frame frame) (type unsigned-byte stack-slot)

-          (type sb!c::sc-offset loc))
+          (type sb!c:sc-offset loc))

   (let ((pointer (frame-pointer frame))
        (escaped (compiled-frame-escaped frame)))
     (if escaped
        (sub-set-debug-var-slot pointer loc value escaped)
        (ecase stack-slot
   (let ((pointer (frame-pointer frame))
        (escaped (compiled-frame-escaped frame)))
     (if escaped
        (sub-set-debug-var-slot pointer loc value escaped)
        (ecase stack-slot

-         (#.sb!vm::ocfp-save-offset
+         (#.ocfp-save-offset

           (setf (stack-ref pointer stack-slot) value))
           (setf (stack-ref pointer stack-slot) value))

-         (#.sb!vm::lra-save-offset
+         (#.lra-save-offset

           (setf (sap-ref-sap pointer (- (* (1+ stack-slot) 4))) value))))))
 
           (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

-;;; down frame, this returns nil for the bottom of the stack. Up-frame
-;;; is the up link for the resulting frame object, and it is nil when
+;;; down frame, this returns NIL for the bottom of the stack. UP-FRAME
+;;; is the up link for the resulting frame object, and it is null when

 ;;; we call this to get the top of the stack.
 ;;;
 ;;; The current frame contains the pointer to the temporally previous
 ;;; we call this to get the top of the stack.
 ;;;
 ;;; The current frame contains the pointer to the temporally previous

@@ -998,7 +788,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)

@@ -1008,13 +798,13 @@
                (if (fixnump lra)
                    (let ((fp (frame-pointer up-frame)))
                      (values lra
                (if (fixnump lra)
                    (let ((fp (frame-pointer up-frame)))
                      (values lra

-                             (stack-ref fp (1+ sb!vm::lra-save-offset))))
+                             (stack-ref fp (1+ lra-save-offset))))

                    (values (get-header-data lra)
                            (lra-code-header lra)))
              (if code
                  (values code
                          (* (1+ (- word-offset (get-header-data code)))
                    (values (get-header-data lra)
                            (lra-code-header lra)))
              (if code
                  (values code
                          (* (1+ (- word-offset (get-header-data code)))

-                            sb!vm:word-bytes)
+                            sb!vm:n-word-bytes)

                          nil)
                  (values :foreign-function
                          0
                          nil)
                  (values :foreign-function
                          0

@@ -1026,211 +816,220 @@
            (compute-calling-frame caller real-lra up-frame))
          (let ((d-fun (case code
                         (:undefined-function
            (compute-calling-frame caller real-lra up-frame))
          (let ((d-fun (case code
                         (:undefined-function

-                         (make-bogus-debug-function
+                         (make-bogus-debug-fun

                           "undefined function"))
                         (:foreign-function
                           "undefined function"))
                         (:foreign-function

-                         (make-bogus-debug-function
+                         (make-bogus-debug-fun

                           "foreign function call land"))
                         ((nil)
                           "foreign function call land"))
                         ((nil)

-                         (make-bogus-debug-function
+                         (make-bogus-debug-fun

                           "bogus stack frame"))
                         (t
                           "bogus stack frame"))
                         (t

-                         (debug-function-from-pc code pc-offset)))))
+                         (debug-fun-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))))))
            (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 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)
+  (/noshow0 "entering COMPUTE-CALLING-FRAME")

   (when (cstack-pointer-valid-p caller)
   (when (cstack-pointer-valid-p caller)

-;    (format t "ccf2~%")
+    (/noshow0 "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"))
+      (/noshow0 "at COND")
+      (cond (code
+            (/noshow0 "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
+            (/noshow0 "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-fun
+                      "undefined function"))
+                    (:foreign-function
+                     (make-bogus-debug-fun
+                      "foreign function call land"))
+                    ((nil)
+                     (make-bogus-debug-fun
+                      "bogus stack frame"))
+                    (t
+                     (debug-fun-from-pc code pc-offset)))))
+       (/noshow0 "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))
+  (/noshow0 "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))
+      (/noshow0 "at head of WITH-ALIEN")

       (let ((context (sb!alien:deref lisp-interrupt-contexts index)))
       (let ((context (sb!alien:deref lisp-interrupt-contexts index)))

+       (/noshow0 "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

+          (/noshow0 "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))))
+            (/noshow0 "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)

-                                       sb!vm:word-bytes))
+                                       sb!vm:n-word-bytes))

                    (pc-offset
                     (- (sap-int (sb!vm:context-pc context))
                        (- (get-lisp-obj-address code)
                    (pc-offset
                     (- (sap-int (sb!vm:context-pc context))
                        (- (get-lisp-obj-address code)

-                          sb!vm:other-pointer-type)
+                          sb!vm:other-pointer-lowtag)

                        code-header-len)))
                        code-header-len)))

+              (/noshow "got PC-OFFSET")

               (unless (<= 0 pc-offset
                           (* (code-header-ref code sb!vm:code-code-size-slot)
               (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.
+                             sb!vm:n-word-bytes))
+                ;; 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))

+              (/noshow0 "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:n-word-bytes))
+                   (pc-offset
+                    (- (sap-int (sb!vm:context-pc scp))
+                       (- (get-lisp-obj-address code)
+                          sb!vm:other-pointer-lowtag)
+                       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:n-word-bytes))
+              (unless (<= 0 pc-offset
+                          (* (code-header-ref code sb!vm:code-code-size-slot)
+                             sb!vm:n-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)))
     (if (functionp object)
 (defun code-object-from-bits (bits)
   (declare (type (unsigned-byte 32) bits))
   (let ((object (make-lisp-obj bits)))
     (if (functionp object)

-       (or (function-code-header object)
+       (or (fun-code-header object)

            :undefined-function)
            :undefined-function)

-       (let ((lowtag (get-lowtag object)))
-         (if (= lowtag sb!vm:other-pointer-type)
-             (let ((type (get-type object)))
-               (cond ((= type sb!vm:code-header-type)
+       (let ((lowtag (lowtag-of object)))
+         (if (= lowtag sb!vm:other-pointer-lowtag)
+             (let ((widetag (widetag-of object)))
+               (cond ((= widetag sb!vm:code-header-widetag)

                       object)
                       object)

-                     ((= type sb!vm:return-pc-header-type)
+                     ((= widetag sb!vm:return-pc-header-widetag)

                       (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
 

-;;; This returns a COMPILED-DEBUG-FUNCTION for code and pc. We fetch
-;;; the SB!C::DEBUG-INFO and run down its function-map to get a
-;;; SB!C::COMPILED-DEBUG-FUNCTION from the pc. The result only needs
-;;; to reference the component, for function constants, and the
-;;; SB!C::COMPILED-DEBUG-FUNCTION.
-(defun debug-function-from-pc (component pc)
+;;; This returns a COMPILED-DEBUG-FUN for code and pc. We fetch the
+;;; SB!C::DEBUG-INFO and run down its FUN-MAP to get a
+;;; SB!C::COMPILED-DEBUG-FUN from the pc. The result only needs to
+;;; reference the component, for function constants, and the
+;;; SB!C::COMPILED-DEBUG-FUN.
+(defun debug-fun-from-pc (component pc)

   (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)
      ((eq info :bogus-lra)

-      (make-bogus-debug-function "function end breakpoint"))
+      (make-bogus-debug-fun "function end breakpoint"))

      (t
      (t

-      (let* ((function-map (get-debug-info-function-map info))
-            (len (length function-map)))
-       (declare (simple-vector function-map))
+      (let* ((fun-map (get-debug-info-fun-map info))
+            (len (length fun-map)))
+       (declare (type simple-vector fun-map))

        (if (= len 1)
        (if (= len 1)

-           (make-compiled-debug-function (svref function-map 0) component)
+           (make-compiled-debug-fun (svref fun-map 0) component)

            (let ((i 1)
                  (elsewhere-p
            (let ((i 1)
                  (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))
+                  (>= pc (sb!c::compiled-debug-fun-elsewhere-pc
+                          (svref fun-map 0)))))
+             (declare (type sb!int:index i))

              (loop
                (when (or (= i len)
                          (< pc (if elsewhere-p
              (loop
                (when (or (= i len)
                          (< pc (if elsewhere-p

-                                   (sb!c::compiled-debug-function-elsewhere-pc
-                                    (svref function-map (1+ i)))
-                                   (svref function-map i))))
-                 (return (make-compiled-debug-function
-                          (svref function-map (1- i))
+                                   (sb!c::compiled-debug-fun-elsewhere-pc
+                                    (svref fun-map (1+ i)))
+                                   (svref fun-map i))))
+                 (return (make-compiled-debug-fun
+                          (svref fun-map (1- i))

                           component)))
                (incf i 2)))))))))
 
                           component)))
                (incf i 2)))))))))
 

-;;; This returns a code-location for the COMPILED-DEBUG-FUNCTION,
+;;; This returns a code-location for the COMPILED-DEBUG-FUN,

 ;;; DEBUG-FUN, and the pc into its code vector. If we stopped at a
 ;;; breakpoint, find the CODE-LOCATION for that breakpoint. Otherwise,
 ;;; make an :UNSURE code location, so it can be filled in when we
 ;;; figure out what is going on.
 (defun code-location-from-pc (debug-fun pc escaped)
 ;;; DEBUG-FUN, and the pc into its code vector. If we stopped at a
 ;;; breakpoint, find the CODE-LOCATION for that breakpoint. Otherwise,
 ;;; make an :UNSURE code location, so it can be filled in when we
 ;;; figure out what is going on.
 (defun code-location-from-pc (debug-fun pc escaped)

-  (or (and (compiled-debug-function-p debug-fun)
+  (or (and (compiled-debug-fun-p debug-fun)

           escaped
           (let ((data (breakpoint-data
           escaped
           (let ((data (breakpoint-data

-                       (compiled-debug-function-component debug-fun)
+                       (compiled-debug-fun-component debug-fun)

                        pc nil)))
             (when (and data (breakpoint-data-breakpoints data))
               (let ((what (breakpoint-what
                        pc nil)))
             (when (and data (breakpoint-data-breakpoints data))
               (let ((what (breakpoint-what

@@ -1239,110 +1038,96 @@
                   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))
-       (res nil)
-       (fp (frame-pointer (frame-real-frame frame))))
-    (loop
-      (when (zerop (sap-int catch)) (return (nreverse res)))
-      (when (sap= fp
-                 #!-alpha
-                 (sap-ref-sap catch
-                                     (* sb!vm:catch-block-current-cont-slot
-                                        sb!vm:word-bytes))
-                 #!+alpha
-                 (:int-sap
-                  (sap-ref-32 catch
-                                     (* sb!vm:catch-block-current-cont-slot
-                                        sb!vm:word-bytes))))
-       (let* (#!-(or gengc x86)
-              (lra (stack-ref catch sb!vm:catch-block-entry-pc-slot))
-              #!+(or gengc x86)
-              (ra (sap-ref-sap
-                   catch (* sb!vm:catch-block-entry-pc-slot
-                            sb!vm:word-bytes)))
-              #!-x86
-              (component
-               (stack-ref catch sb!vm:catch-block-current-code-slot))
-              #!+x86
-              (component (component-from-component-ptr
-                          (component-ptr-from-pc ra)))
-              (offset
-               #!-(or gengc x86)
-               (* (- (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)
-                     sb!vm:other-pointer-type)
-                  (* (get-header-data component) sb!vm:word-bytes))))
-         (push (cons #!-x86
-                     (stack-ref catch sb!vm:catch-block-tag-slot)
-                     #!+x86
-                     (make-lisp-obj
-                      (sap-ref-32 catch (* sb!vm:catch-block-tag-slot
-                                                  sb!vm:word-bytes)))
-                     (make-compiled-code-location
-                      offset (frame-debug-function frame)))
-               res)))
-      (setf catch
-           #!-alpha
-           (sap-ref-sap catch
-                               (* sb!vm:catch-block-previous-catch-slot
-                                  sb!vm:word-bytes))
-           #!+alpha
-           (:int-sap
-            (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))))
+  (let ((catch (descriptor-sap sb!vm:*current-catch-block*))
+       (reversed-result nil)
+       (fp (frame-pointer frame)))
+    (loop until (zerop (sap-int catch))
+         finally (return (nreverse reversed-result))
+         do
+         (when (sap= fp
+                     #!-alpha
+                     (sap-ref-sap catch
+                                  (* sb!vm:catch-block-current-cont-slot
+                                     sb!vm:n-word-bytes))
+                     #!+alpha
+                     (int-sap
+                      (sap-ref-32 catch
+                                  (* sb!vm:catch-block-current-cont-slot
+                                     sb!vm:n-word-bytes))))
+           (let* (#!-x86
+                  (lra (stack-ref catch sb!vm:catch-block-entry-pc-slot))
+                  #!+x86
+                  (ra (sap-ref-sap
+                       catch (* sb!vm:catch-block-entry-pc-slot
+                                sb!vm:n-word-bytes)))
+                  #!-x86
+                  (component
+                   (stack-ref catch sb!vm:catch-block-current-code-slot))
+                  #!+x86
+                  (component (component-from-component-ptr
+                              (component-ptr-from-pc ra)))
+                  (offset
+                   #!-x86
+                   (* (- (1+ (get-header-data lra))
+                         (get-header-data component))
+                      sb!vm:n-word-bytes)
+                   #!+x86
+                   (- (sap-int ra)
+                      (- (get-lisp-obj-address component)
+                         sb!vm:other-pointer-lowtag)
+                      (* (get-header-data component) sb!vm:n-word-bytes))))
+             (push (cons #!-x86
+                         (stack-ref catch sb!vm:catch-block-tag-slot)
+                         #!+x86
+                         (make-lisp-obj
+                          (sap-ref-32 catch (* sb!vm:catch-block-tag-slot
+                                               sb!vm:n-word-bytes)))
+                         (make-compiled-code-location
+                          offset (frame-debug-fun frame)))
+                   reversed-result)))
+         (setf catch
+               #!-alpha
+               (sap-ref-sap catch
+                            (* sb!vm:catch-block-previous-catch-slot
+                               sb!vm:n-word-bytes))
+               #!+alpha
+               (int-sap
+                (sap-ref-32 catch
+                            (* sb!vm:catch-block-previous-catch-slot
+                               sb!vm:n-word-bytes)))))))

 \f
 \f

-;;;; operations on DEBUG-FUNCTIONs
-
-(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."
+;;;; operations on DEBUG-FUNs
+
+;;; Execute the forms in a context with BLOCK-VAR bound to each
+;;; DEBUG-BLOCK in DEBUG-FUN successively. Result is an optional
+;;; form to execute for return values, and DO-DEBUG-FUN-BLOCKS
+;;; returns nil if there is no result form. This signals a
+;;; NO-DEBUG-BLOCKS condition when the DEBUG-FUN lacks
+;;; DEBUG-BLOCK information.
+(defmacro do-debug-fun-blocks ((block-var debug-fun &optional result)
+                              &body body)

   (let ((blocks (gensym))
        (i (gensym)))
   (let ((blocks (gensym))
        (i (gensym)))

-    `(let ((,blocks (debug-function-debug-blocks ,debug-function)))
+    `(let ((,blocks (debug-fun-debug-blocks ,debug-fun)))

        (declare (simple-vector ,blocks))
        (dotimes (,i (length ,blocks) ,result)
         (let ((,block-var (svref ,blocks ,i)))
           ,@body)))))
 
        (declare (simple-vector ,blocks))
        (dotimes (,i (length ,blocks) ,result)
         (let ((,block-var (svref ,blocks ,i)))
           ,@body)))))
 

-(defmacro do-debug-function-variables ((var debug-function &optional result)
+;;; Execute body in a context with VAR bound to each DEBUG-VAR in
+;;; DEBUG-FUN. This returns the value of executing result (defaults to
+;;; nil). This may iterate over only some of DEBUG-FUN's variables or
+;;; none depending on debug policy; for example, possibly the
+;;; compilation only preserved argument information.
+(defmacro do-debug-fun-variables ((var debug-fun &optional result)

                                       &body body)
                                       &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 (gensym))
        (i (gensym)))

-    `(let ((,vars (debug-function-debug-vars ,debug-function)))
+    `(let ((,vars (debug-fun-debug-vars ,debug-fun)))

        (declare (type (or null simple-vector) ,vars))
        (if ,vars
           (dotimes (,i (length ,vars) ,result)
        (declare (type (or null simple-vector) ,vars))
        (if ,vars
           (dotimes (,i (length ,vars) ,result)

@@ -1350,76 +1135,62 @@
               ,@body))
           ,result))))
 
               ,@body))
           ,result))))
 

-(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)))
+;;; Return the object of type FUNCTION associated with the DEBUG-FUN,
+;;; or NIL if the function is unavailable or is non-existent as a user
+;;; callable function object.
+(defun debug-fun-fun (debug-fun)
+  (let ((cached-value (debug-fun-%function debug-fun)))

     (if (eq cached-value :unparsed)
     (if (eq cached-value :unparsed)

-       (setf (debug-function-%function debug-function)
-             (etypecase debug-function
-               (compiled-debug-function
+       (setf (debug-fun-%function debug-fun)
+             (etypecase debug-fun
+               (compiled-debug-fun

                 (let ((component
                 (let ((component

-                       (compiled-debug-function-component debug-function))
+                       (compiled-debug-fun-component debug-fun))

                       (start-pc
                       (start-pc

-                       (sb!c::compiled-debug-function-start-pc
-                        (compiled-debug-function-compiler-debug-fun
-                         debug-function))))
+                       (sb!c::compiled-debug-fun-start-pc
+                        (compiled-debug-fun-compiler-debug-fun debug-fun))))

                   (do ((entry (%code-entry-points component)
                   (do ((entry (%code-entry-points component)

-                              (%function-next entry)))
+                              (%simple-fun-next entry)))

                       ((null entry) nil)
                     (when (= start-pc
                       ((null entry) nil)
                     (when (= start-pc

-                             (sb!c::compiled-debug-function-start-pc
-                              (compiled-debug-function-compiler-debug-fun
-                               (function-debug-function entry))))
+                             (sb!c::compiled-debug-fun-start-pc
+                              (compiled-debug-fun-compiler-debug-fun
+                               (fun-debug-fun entry))))

                       (return 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)))
+               (bogus-debug-fun nil)))

        cached-value)))
 
        cached-value)))
 

-(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)))
-    (interpreted-debug-function
-     (sb!c::lambda-name (interpreted-debug-function-ir1-lambda
-                        debug-function)))
-    (bogus-debug-function
-     (bogus-debug-function-%name debug-function))))
-
-(defun function-debug-function (fun)
-  #!+sb-doc
-  "Returns a debug-function that represents debug information for function."
-  (case (get-type fun)
-    (#.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)))))
-    ((#.sb!vm:function-header-type #.sb!vm:closure-function-header-type)
-      (let* ((name (%function-name fun))
-            (component (function-code-header fun))
+;;; Return the name of the function represented by DEBUG-FUN. This may
+;;; be a string or a cons; do not assume it is a symbol.
+(defun debug-fun-name (debug-fun)
+  (etypecase debug-fun
+    (compiled-debug-fun
+     (sb!c::compiled-debug-fun-name
+      (compiled-debug-fun-compiler-debug-fun debug-fun)))
+    (bogus-debug-fun
+     (bogus-debug-fun-%name debug-fun))))
+
+;;; Return a DEBUG-FUN that represents debug information for FUN.
+(defun fun-debug-fun (fun)
+  (declare (type function fun))
+  (ecase (widetag-of fun)
+    (#.sb!vm:closure-header-widetag
+     (fun-debug-fun (%closure-fun fun)))
+    (#.sb!vm:funcallable-instance-header-widetag
+     (fun-debug-fun (funcallable-instance-fun fun)))
+    ((#.sb!vm:simple-fun-header-widetag
+      #.sb!vm:closure-fun-header-widetag)
+      (let* ((name (%simple-fun-name fun))
+            (component (fun-code-header fun))

             (res (find-if
             (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)))
-                  (get-debug-info-function-map
+                  (lambda (x)
+                    (and (sb!c::compiled-debug-fun-p x)
+                         (eq (sb!c::compiled-debug-fun-name x) name)
+                         (eq (sb!c::compiled-debug-fun-kind x) nil)))
+                  (get-debug-info-fun-map

                    (%code-debug-info component)))))
        (if res
                    (%code-debug-info component)))))
        (if res

-           (make-compiled-debug-function res component)
+           (make-compiled-debug-fun res component)

            ;; KLUDGE: comment from CMU CL:
            ;;   This used to be the non-interpreted branch, but
            ;;   William wrote it to return the debug-fun of fun's XEP
            ;; KLUDGE: comment from CMU CL:
            ;;   This used to be the non-interpreted branch, but
            ;;   William wrote it to return the debug-fun of fun's XEP

@@ -1428,41 +1199,35 @@
            ;;   appropriate cases. It mostly works, and probably
            ;;   works for all named functions anyway.
            ;; -- WHN 20000120
            ;;   appropriate cases. It mostly works, and probably
            ;;   works for all named functions anyway.
            ;; -- WHN 20000120

-           (debug-function-from-pc component
-                                   (* (- (function-word-offset fun)
-                                         (get-header-data component))
-                                      sb!vm:word-bytes)))))))
-
-(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."
+           (debug-fun-from-pc component
+                              (* (- (fun-word-offset fun)
+                                    (get-header-data component))
+                                 sb!vm:n-word-bytes)))))))
+
+;;; Return the kind of the function, which is one of :OPTIONAL,
+;;; :EXTERNAL, :TOPLEVEL, :CLEANUP, or NIL.
+(defun debug-fun-kind (debug-fun)

   ;; FIXME: This "is one of" information should become part of the function
   ;; declamation, not just a doc string
   ;; 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
+  (etypecase debug-fun
+    (compiled-debug-fun
+     (sb!c::compiled-debug-fun-kind
+      (compiled-debug-fun-compiler-debug-fun debug-fun)))
+    (bogus-debug-fun

      nil)))
 
      nil)))
 

-(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))))
-
-(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)))
+;;; Is there any variable information for DEBUG-FUN?
+(defun debug-var-info-available (debug-fun)
+  (not (not (debug-fun-debug-vars debug-fun))))
+
+;;; Return a list of DEBUG-VARs in DEBUG-FUN 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-FUN; for
+;;; example, possibly DEBUG-FUN only knows about its arguments.
+(defun debug-fun-symbol-variables (debug-fun symbol)
+  (let ((vars (ambiguous-debug-vars debug-fun (symbol-name symbol)))

        (package (and (symbol-package symbol)
                      (package-name (symbol-package symbol)))))
     (delete-if (if (stringp package)
        (package (and (symbol-package symbol)
                      (package-name (symbol-package symbol)))))
     (delete-if (if (stringp package)

@@ -1474,13 +1239,14 @@
                     (stringp (debug-var-package-name var))))
               vars)))
 
                     (stringp (debug-var-package-name var))))
               vars)))
 

-(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."
+;;; Return a list of DEBUG-VARs in DEBUG-FUN whose names contain
+;;; NAME-PREFIX-STRING as an initial substring. The result of this
+;;; function is limited to the availability of variable information in
+;;; debug-fun; for example, possibly debug-fun only knows
+;;; about its arguments.
+(defun ambiguous-debug-vars (debug-fun name-prefix-string)

   (declare (simple-string name-prefix-string))
   (declare (simple-string name-prefix-string))

-  (let ((variables (debug-function-debug-vars debug-function)))
+  (let ((variables (debug-fun-debug-vars debug-fun)))

     (declare (type (or null simple-vector) variables))
     (if variables
        (let* ((len (length variables))
     (declare (type (or null simple-vector) variables))
     (if variables
        (let* ((len (length variables))

@@ -1519,111 +1285,44 @@
                               (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)))))
 

-(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))
-    (interpreted-debug-function
-     (interpreted-debug-function-lambda-list debug-function))
-    (bogus-debug-function
-     nil)))
+;;; Return a list representing the lambda-list for DEBUG-FUN. 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-FUN. This signals a
+;;; LAMBDA-LIST-UNAVAILABLE condition when there is no argument list
+;;; information.
+(defun debug-fun-lambda-list (debug-fun)
+  (etypecase debug-fun
+    (compiled-debug-fun (compiled-debug-fun-lambda-list debug-fun))
+    (bogus-debug-fun 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.
-(defun compiled-debug-function-lambda-list (debug-function)
-  (let ((lambda-list (debug-function-%lambda-list debug-function)))
+;;; Note: If this has to compute the lambda list, it caches it in DEBUG-FUN.
+(defun compiled-debug-fun-lambda-list (debug-fun)
+  (let ((lambda-list (debug-fun-%lambda-list debug-fun)))

     (cond ((eq lambda-list :unparsed)
           (multiple-value-bind (args argsp)
     (cond ((eq lambda-list :unparsed)
           (multiple-value-bind (args argsp)

-              (parse-compiled-debug-function-lambda-list debug-function)
-            (setf (debug-function-%lambda-list debug-function) args)
+              (parse-compiled-debug-fun-lambda-list debug-fun)
+            (setf (debug-fun-%lambda-list debug-fun) args)

             (if argsp
                 args
                 (debug-signal 'lambda-list-unavailable
             (if argsp
                 args
                 (debug-signal 'lambda-list-unavailable

-                              :debug-function debug-function))))
+                              :debug-fun debug-fun))))

          (lambda-list)
          (lambda-list)

-         ((bogus-debug-function-p debug-function)
+         ((bogus-debug-fun-p debug-fun)

           nil)
           nil)

-         ((sb!c::compiled-debug-function-arguments
-           (compiled-debug-function-compiler-debug-fun
-            debug-function))
+         ((sb!c::compiled-debug-fun-arguments
+           (compiled-debug-fun-compiler-debug-fun debug-fun))

           ;; If the packed information is there (whether empty or not) as
           ;; opposed to being nil, then returned our cached value (nil).
           nil)
           ;; If the packed information is there (whether empty or not) as
           ;; opposed to being nil, then returned our cached value (nil).
           nil)

@@ -1631,26 +1330,25 @@
           ;; Our cached value is nil, and the packed lambda-list information
           ;; is nil, so we don't have anything available.
           (debug-signal 'lambda-list-unavailable
           ;; Our cached value is nil, and the packed lambda-list information
           ;; is nil, so we don't have anything available.
           (debug-signal 'lambda-list-unavailable

-                        :debug-function debug-function)))))
-
-;;; COMPILED-DEBUG-FUNCTION-LAMBDA-LIST calls this when a
-;;; compiled-debug-function has no lambda-list information cached. It
-;;; returns the lambda-list as the first value and whether there was
-;;; any argument information as the second value. Therefore, nil and t
-;;; means there were no arguments, but nil and nil means there was no
-;;; argument information.
-(defun parse-compiled-debug-function-lambda-list (debug-function)
-  (let ((args (sb!c::compiled-debug-function-arguments
-              (compiled-debug-function-compiler-debug-fun
-               debug-function))))
+                        :debug-fun debug-fun)))))
+
+;;; COMPILED-DEBUG-FUN-LAMBDA-LIST calls this when a
+;;; COMPILED-DEBUG-FUN has no lambda list information cached. It
+;;; returns the lambda list as the first value and whether there was
+;;; any argument information as the second value. Therefore,
+;;; (VALUES NIL T) means there were no arguments, but (VALUES NIL NIL)
+;;; means there was no argument information.
+(defun parse-compiled-debug-fun-lambda-list (debug-fun)
+  (let ((args (sb!c::compiled-debug-fun-arguments
+              (compiled-debug-fun-compiler-debug-fun debug-fun))))

     (cond
      ((not args)
       (values nil nil))
      ((eq args :minimal)
     (cond
      ((not args)
       (values nil nil))
      ((eq args :minimal)

-      (values (coerce (debug-function-debug-vars debug-function) 'list)
+      (values (coerce (debug-fun-debug-vars debug-fun) 'list)

              t))
      (t
              t))
      (t

-      (let ((vars (debug-function-debug-vars debug-function))
+      (let ((vars (debug-fun-debug-vars debug-fun))

            (i 0)
            (len (length args))
            (res nil)
            (i 0)
            (len (length args))
            (res nil)

@@ -1673,23 +1371,23 @@
                 ;; element representing the keyword or optional,
                 ;; which is the previous one.
                 (nconc (car res)
                 ;; element representing the keyword or optional,
                 ;; which is the previous one.
                 (nconc (car res)

-                       (list (compiled-debug-function-lambda-list-var
+                       (list (compiled-debug-fun-lambda-list-var

                               args (incf i) vars))))
                (sb!c::rest-arg
                 (push (list :rest
                               args (incf i) vars))))
                (sb!c::rest-arg
                 (push (list :rest

-                            (compiled-debug-function-lambda-list-var
+                            (compiled-debug-fun-lambda-list-var

                              args (incf i) vars))
                       res))
                (sb!c::more-arg
                 ;; Just ignore the fact that the next two args are
                              args (incf i) vars))
                       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
                 (push (list :keyword
                             ele

-                            (compiled-debug-function-lambda-list-var
+                            (compiled-debug-fun-lambda-list-var

                              args (incf i) vars))
                       res))))
             (optionalp
                              args (incf i) vars))
                       res))))
             (optionalp

@@ -1703,8 +1401,8 @@
          (incf i))
        (values (nreverse res) t))))))
 
          (incf i))
        (values (nreverse res) t))))))
 

-;;; This is used in COMPILED-DEBUG-FUNCTION-LAMBDA-LIST.
-(defun compiled-debug-function-lambda-list-var (args i vars)
+;;; This is used in COMPILED-DEBUG-FUN-LAMBDA-LIST.
+(defun compiled-debug-fun-lambda-list-var (args i vars)

   (declare (type (simple-array * (*)) args)
           (simple-vector vars))
   (let ((ele (aref args i)))
   (declare (type (simple-array * (*)) args)
           (simple-vector vars))
   (let ((ele (aref args i)))

@@ -1712,8 +1410,8 @@
          ((eq ele 'sb!c::deleted) :deleted)
          (t (error "malformed arguments description")))))
 
          ((eq ele 'sb!c::deleted) :deleted)
          (t (error "malformed arguments description")))))
 

-(defun compiled-debug-function-debug-info (debug-fun)
-  (%code-debug-info (compiled-debug-function-component debug-fun)))
+(defun compiled-debug-fun-debug-info (debug-fun)
+  (%code-debug-info (compiled-debug-fun-component debug-fun)))

 \f
 ;;;; unpacking variable and basic block data
 
 \f
 ;;;; unpacking variable and basic block data
 

@@ -1721,7 +1419,7 @@
   (make-array 20 :adjustable t :fill-pointer t))
 (defvar *other-parsing-buffer*
   (make-array 20 :adjustable t :fill-pointer t))
   (make-array 20 :adjustable t :fill-pointer t))
 (defvar *other-parsing-buffer*
   (make-array 20 :adjustable t :fill-pointer t))

-;;; PARSE-DEBUG-BLOCKS, PARSE-DEBUG-VARS and UNCOMPACT-FUNCTION-MAP
+;;; PARSE-DEBUG-BLOCKS and PARSE-DEBUG-VARS

 ;;; use this to unpack binary encoded information. It returns the
 ;;; values returned by the last form in body.
 ;;;
 ;;; use this to unpack binary encoded information. It returns the
 ;;; values returned by the last form in body.
 ;;;

@@ -1760,46 +1458,45 @@
 ) ; EVAL-WHEN
 
 ;;; The argument is a debug internals structure. This returns the
 ) ; EVAL-WHEN
 
 ;;; The argument is a debug internals structure. This returns the

-;;; debug-blocks for debug-function, regardless of whether we have
-;;; unpacked them yet. It signals a no-debug-blocks condition if it
-;;; can't return the blocks.
-(defun debug-function-debug-blocks (debug-function)
-  (let ((blocks (debug-function-blocks debug-function)))
+;;; DEBUG-BLOCKs for DEBUG-FUN, regardless of whether we have unpacked
+;;; them yet. It signals a NO-DEBUG-BLOCKS condition if it can't
+;;; return the blocks.
+(defun debug-fun-debug-blocks (debug-fun)
+  (let ((blocks (debug-fun-blocks debug-fun)))

     (cond ((eq blocks :unparsed)
     (cond ((eq blocks :unparsed)

-          (setf (debug-function-blocks debug-function)
-                (parse-debug-blocks debug-function))
-          (unless (debug-function-blocks debug-function)
+          (setf (debug-fun-blocks debug-fun)
+                (parse-debug-blocks debug-fun))
+          (unless (debug-fun-blocks debug-fun)

             (debug-signal 'no-debug-blocks
             (debug-signal 'no-debug-blocks

-                          :debug-function debug-function))
-          (debug-function-blocks debug-function))
+                          :debug-fun debug-fun))
+          (debug-fun-blocks debug-fun))

          (blocks)
          (t
           (debug-signal 'no-debug-blocks
          (blocks)
          (t
           (debug-signal 'no-debug-blocks

-                        :debug-function debug-function)))))
-
-;;; 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
-     (debug-signal 'no-debug-blocks :debug-function debug-function))
-    (interpreted-debug-function
-     (parse-interpreted-debug-blocks debug-function))))
+                        :debug-fun debug-fun)))))
+
+;;; Return a SIMPLE-VECTOR of DEBUG-BLOCKs or NIL. NIL indicates there
+;;; was no basic block information.
+(defun parse-debug-blocks (debug-fun)
+  (etypecase debug-fun
+    (compiled-debug-fun
+     (parse-compiled-debug-blocks debug-fun))
+    (bogus-debug-fun
+     (debug-signal 'no-debug-blocks :debug-fun debug-fun))))

 
 ;;; This does some of the work of PARSE-DEBUG-BLOCKS.
 
 ;;; This does some of the work of PARSE-DEBUG-BLOCKS.

-(defun parse-compiled-debug-blocks (debug-function)
-  (let* ((debug-fun (compiled-debug-function-compiler-debug-fun
-                    debug-function))
-        (var-count (length (debug-function-debug-vars debug-function)))
-        (blocks (sb!c::compiled-debug-function-blocks debug-fun))
+(defun parse-compiled-debug-blocks (debug-fun)
+  (let* ((var-count (length (debug-fun-debug-vars debug-fun)))
+        (compiler-debug-fun (compiled-debug-fun-compiler-debug-fun
+                             debug-fun))
+        (blocks (sb!c::compiled-debug-fun-blocks compiler-debug-fun))

         ;; KLUDGE: 8 is a hard-wired constant in the compiler for the
         ;; element size of the packed binary representation of the
         ;; blocks data.
         (live-set-len (ceiling var-count 8))
         ;; KLUDGE: 8 is a hard-wired constant in the compiler for the
         ;; element size of the packed binary representation of the
         ;; blocks data.
         (live-set-len (ceiling var-count 8))

-        (tlf-number (sb!c::compiled-debug-function-tlf-number debug-fun)))
-    (unless blocks (return-from parse-compiled-debug-blocks nil))
+        (tlf-number (sb!c::compiled-debug-fun-tlf-number compiler-debug-fun)))
+    (unless blocks
+      (return-from parse-compiled-debug-blocks nil))

     (macrolet ((aref+ (a i) `(prog1 (aref ,a ,i) (incf ,i))))
       (with-parsing-buffer (blocks-buffer locations-buffer)
        (let ((i 0)
     (macrolet ((aref+ (a i) `(prog1 (aref ,a ,i) (incf ,i))))
       (with-parsing-buffer (blocks-buffer locations-buffer)
        (let ((i 0)

@@ -1817,7 +1514,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)))

@@ -1828,7 +1525,7 @@
                              (live-set (sb!c::read-packed-bit-vector
                                         live-set-len blocks i)))
                          (vector-push-extend (make-known-code-location
                              (live-set (sb!c::read-packed-bit-vector
                                         live-set-len blocks i)))
                          (vector-push-extend (make-known-code-location

-                                              pc debug-function tlf-offset
+                                              pc debug-fun tlf-offset

                                               form-number live-set kind)
                                              locations-buffer)
                          (setf last-pc pc))))
                                               form-number live-set kind)
                                              locations-buffer)
                          (setf last-pc pc))))

@@ -1851,90 +1548,33 @@
              (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.
-(defun debug-function-debug-vars (debug-function)
-  (let ((vars (debug-function-%debug-vars debug-function)))
+;;; it returns a SIMPLE-VECTOR of DEBUG-VARs.
+(defun debug-fun-debug-vars (debug-fun)
+  (let ((vars (debug-fun-%debug-vars debug-fun)))

     (if (eq vars :unparsed)
     (if (eq vars :unparsed)

-       (setf (debug-function-%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))))
+       (setf (debug-fun-%debug-vars debug-fun)
+             (etypecase debug-fun
+               (compiled-debug-fun
+                (parse-compiled-debug-vars debug-fun))
+               (bogus-debug-fun 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))

-        (width (length (format nil "~D" (1- len)))))
+        (width (length (format nil "~W" (1- len)))))

     (dotimes (i len)
       (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
     (dotimes (i len)
       (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..

@@ -1946,15 +1586,17 @@
                    ;; 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
 
 ;;; Parse the packed representation of DEBUG-VARs from

-;;; DEBUG-FUNCTION's SB!C::COMPILED-DEBUG-FUNCTION, returning a vector
+;;; DEBUG-FUN's SB!C::COMPILED-DEBUG-FUN, returning a vector

 ;;; of DEBUG-VARs, or NIL if there was no information to parse.
 ;;; 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))
-        (packed-vars (sb!c::compiled-debug-function-variables cdebug-fun))
-        (args-minimal (eq (sb!c::compiled-debug-function-arguments cdebug-fun)
+(defun parse-compiled-debug-vars (debug-fun)
+  (let* ((cdebug-fun (compiled-debug-fun-compiler-debug-fun
+                     debug-fun))
+        (packed-vars (sb!c::compiled-debug-fun-variables cdebug-fun))
+        (args-minimal (eq (sb!c::compiled-debug-fun-arguments cdebug-fun)

                           :minimal)))
     (when packed-vars
       (do ((i 0)
                           :minimal)))
     (when packed-vars
       (do ((i 0)

@@ -1968,7 +1610,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)

@@ -1976,7 +1619,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

@@ -1986,125 +1629,26 @@
 \f
 ;;;; unpacking minimal debug functions
 
 \f
 ;;;; unpacking minimal debug functions
 

-(eval-when (:compile-toplevel :execute)
-
-;;; sleazoid "macro" to keep our indentation sane in UNCOMPACT-FUNCTION-MAP
-(sb!xc:defmacro make-uncompacted-debug-fun ()
-  '(sb!c::make-compiled-debug-function
-    :name
-    (let ((base (ecase (ldb sb!c::minimal-debug-function-name-style-byte
-                           options)
-                 (#.sb!c::minimal-debug-function-name-symbol
-                  (intern (sb!c::read-var-string map i)
-                          (sb!c::compiled-debug-info-package info)))
-                 (#.sb!c::minimal-debug-function-name-packaged
-                  (let ((pkg (sb!c::read-var-string map i)))
-                    (intern (sb!c::read-var-string map i) pkg)))
-                 (#.sb!c::minimal-debug-function-name-uninterned
-                  (make-symbol (sb!c::read-var-string map i)))
-                 (#.sb!c::minimal-debug-function-name-component
-                  (sb!c::compiled-debug-info-name info)))))
-      (if (logtest flags sb!c::minimal-debug-function-setf-bit)
-         `(setf ,base)
-         base))
-    :kind (svref sb!c::minimal-debug-function-kinds
-                (ldb sb!c::minimal-debug-function-kind-byte options))
-    :variables
-    (when vars-p
-      (let ((len (sb!c::read-var-integer map i)))
-       (prog1 (subseq map i (+ i len))
-         (incf i len))))
-    :arguments (when vars-p :minimal)
-    :returns
-    (ecase (ldb sb!c::minimal-debug-function-returns-byte options)
-      (#.sb!c::minimal-debug-function-returns-standard
-       :standard)
-      (#.sb!c::minimal-debug-function-returns-fixed
-       :fixed)
-      (#.sb!c::minimal-debug-function-returns-specified
-       (with-parsing-buffer (buf)
-        (dotimes (idx (sb!c::read-var-integer map i))
-          (vector-push-extend (sb!c::read-var-integer map i) buf))
-        (result buf))))
-    :return-pc (sb!c::read-var-integer map i)
-    :old-fp (sb!c::read-var-integer map i)
-    :nfp (when (logtest flags sb!c::minimal-debug-function-nfp-bit)
-          (sb!c::read-var-integer map i))
-    :start-pc
-    (progn
-      (setq code-start-pc (+ code-start-pc (sb!c::read-var-integer map i)))
-      (+ code-start-pc (sb!c::read-var-integer map i)))
-    :elsewhere-pc
-    (setq elsewhere-pc (+ elsewhere-pc (sb!c::read-var-integer map i)))))
-
-) ; EVAL-WHEN
-
-;;; Return a normal function map derived from a minimal debug info
-;;; function map. This involves looping parsing
-;;; minimal-debug-functions and then building a vector out of them.
-;;;
-;;; FIXME: This and its helper macro just above become dead code now
-;;; that we no longer use compacted function maps.
-(defun uncompact-function-map (info)
-  (declare (type sb!c::compiled-debug-info info))
-
-  ;; (This is stubified until we solve the problem of representing
-  ;; debug information in a way which plays nicely with package renaming.)
-  (error "FIXME: dead code UNCOMPACT-FUNCTION-MAP (was stub)")
-
-  (let* ((map (sb!c::compiled-debug-info-function-map info))
-        (i 0)
-        (len (length map))
-        (code-start-pc 0)
-        (elsewhere-pc 0))
-    (declare (type (simple-array (unsigned-byte 8) (*)) map))
-    (sb!int:collect ((res))
-      (loop
-       (when (= i len) (return))
-       (let* ((options (prog1 (aref map i) (incf i)))
-              (flags (prog1 (aref map i) (incf i)))
-              (vars-p (logtest flags
-                               sb!c::minimal-debug-function-variables-bit))
-              (dfun (make-uncompacted-debug-fun)))
-         (res code-start-pc)
-         (res dfun)))
-
-      (coerce (cdr (res)) 'simple-vector))))
-
-;;; This variable maps minimal debug-info function maps to an unpacked
-;;; version thereof.
-(defvar *uncompacted-function-maps* (make-hash-table :test 'eq))
-
-;;; Return a function-map for a given compiled-debug-info object. If
-;;; the info is minimal, and has not been parsed, then parse it.
-;;;
-;;; 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
-;;; can be deleted.
-(defun get-debug-info-function-map (info)
+;;; Return a FUN-MAP for a given COMPILED-DEBUG-INFO object.
+(defun get-debug-info-fun-map (info)

   (declare (type sb!c::compiled-debug-info info))
   (declare (type sb!c::compiled-debug-info info))

-  (let ((map (sb!c::compiled-debug-info-function-map info)))
-    (if (simple-vector-p map)
-       map
-       (or (gethash map *uncompacted-function-maps*)
-           (setf (gethash map *uncompacted-function-maps*)
-                 (uncompact-function-map info))))))
+  (let ((map (sb!c::compiled-debug-info-fun-map info)))
+    ;; The old CMU CL had various hairy possibilities here, but in
+    ;; SBCL we only use this one, right? 
+    (aver (simple-vector-p map))
+    ;; So it's easy..
+    map))

 \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)

@@ -2113,27 +1657,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
-;;; DEBUG-FUNCTION-DEBUG-BLOCKS to return the cached block information
-;;; or signal a 'no-debug-blocks condition. The blocks are sorted by
+;;; Store and return BASIC-CODE-LOCATION's debug-block. We determines
+;;; the correct one using the code-location's pc. We use
+;;; DEBUG-FUN-DEBUG-BLOCKS to return the cached block information
+;;; 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

@@ -2144,9 +1685,9 @@
 ;;; code first in order to see how to compare the code-location's pc.
 (defun compute-compiled-code-location-debug-block (basic-code-location)
   (let* ((pc (compiled-code-location-pc basic-code-location))
 ;;; code first in order to see how to compare the code-location's pc.
 (defun compute-compiled-code-location-debug-block (basic-code-location)
   (let* ((pc (compiled-code-location-pc basic-code-location))

-        (debug-function (code-location-debug-function
+        (debug-fun (code-location-debug-fun

                          basic-code-location))
                          basic-code-location))

-        (blocks (debug-function-debug-blocks debug-function))
+        (blocks (debug-fun-debug-blocks debug-fun))

         (len (length blocks)))
     (declare (simple-vector blocks))
     (setf (code-location-%debug-block basic-code-location)
         (len (length blocks)))
     (declare (simple-vector blocks))
     (setf (code-location-%debug-block basic-code-location)

@@ -2159,9 +1700,9 @@
                     (cond
                      ((debug-block-elsewhere-p last)
                       (if (< pc
                     (cond
                      ((debug-block-elsewhere-p last)
                       (if (< pc

-                             (sb!c::compiled-debug-function-elsewhere-pc
-                              (compiled-debug-function-compiler-debug-fun
-                               debug-function)))
+                             (sb!c::compiled-debug-fun-elsewhere-pc
+                              (compiled-debug-fun-compiler-debug-fun
+                               debug-fun)))

                           (svref blocks (1- end))
                           last))
                      ((< pc
                           (svref blocks (1- end))
                           last))
                      ((< pc

@@ -2170,7 +1711,7 @@
                                  0)))
                       (svref blocks (1- end)))
                      (t last))))
                                  0)))
                       (svref blocks (1- end)))
                      (t last))))

-               (declare (type sb!c::index i end))
+               (declare (type index i end))

                (when (< pc
                         (compiled-code-location-pc
                          (svref (compiled-debug-block-code-locations
                (when (< pc
                         (compiled-code-location-pc
                          (svref (compiled-debug-block-code-locations

@@ -2178,42 +1719,35 @@
                                 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
   (etypecase code-location
     (compiled-code-location

-     (let* ((info (compiled-debug-function-debug-info
-                  (code-location-debug-function code-location)))
+     (let* ((info (compiled-debug-fun-debug-info
+                  (code-location-debug-fun code-location)))

            (sources (sb!c::compiled-debug-info-source info))
            (len (length sources)))
        (declare (list sources))
        (when (zerop len)
            (sources (sb!c::compiled-debug-info-source info))
            (len (length sources)))
        (declare (list sources))
        (when (zerop len)

-        (debug-signal 'no-debug-blocks :debug-function
-                      (code-location-debug-function code-location)))
+        (debug-signal 'no-debug-blocks :debug-fun
+                      (code-location-debug-fun code-location)))

        (if (= len 1)
           (car sources)
           (do ((prev sources src)
                (src (cdr sources) (cdr src))
        (if (= len 1)
           (car sources)
           (do ((prev sources src)
                (src (cdr sources) (cdr src))

-               (offset (code-location-top-level-form-offset code-location)))
+               (offset (code-location-toplevel-form-offset code-location)))

               ((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))))))))))
-
-(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."
+    ;; (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-toplevel-form-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)))
   (when (code-location-unknown-p code-location)
     (error 'unknown-code-location :code-location code-location))
   (let ((tlf-offset (code-location-%tlf-offset code-location)))

@@ -2225,18 +1759,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)))

@@ -2248,19 +1780,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

@@ -2273,8 +1803,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.

@@ -2284,8 +1816,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.

@@ -2293,38 +1825,36 @@
               (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
        (compiled-code-location
   (etypecase obj1
     (compiled-code-location
      (etypecase obj2
        (compiled-code-location

-       (and (eq (code-location-debug-function obj1)
-                (code-location-debug-function obj2))
+       (and (eq (code-location-debug-fun obj1)
+                (code-location-debug-fun obj2))

             (sub-compiled-code-location= obj1 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
 ;;; 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
+;;; DEBUG-FUN's debug-block information. This may signal a
+;;; NO-DEBUG-BLOCKS condition due to DEBUG-FUN-DEBUG-BLOCKS, and

 ;;; it assumes the %UNKNOWN-P slot is already set or going to be set.
 (defun fill-in-code-location (code-location)
   (declare (type compiled-code-location code-location))
 ;;; it assumes the %UNKNOWN-P slot is already set or going to be set.
 (defun fill-in-code-location (code-location)
   (declare (type compiled-code-location code-location))

-  (let* ((debug-function (code-location-debug-function code-location))
-        (blocks (debug-function-debug-blocks debug-function)))
+  (let* ((debug-fun (code-location-debug-fun code-location))
+        (blocks (debug-fun-debug-blocks debug-fun)))

     (declare (simple-vector blocks))
     (dotimes (i (length blocks) nil)
       (let* ((block (svref blocks i))
     (declare (simple-vector blocks))
     (dotimes (i (length blocks) nil)
       (let* ((block (svref blocks i))

@@ -2346,57 +1876,40 @@
 \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)))))
 

-(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."
+;;; Return the name of the function represented by DEBUG-FUN.
+;;; This may be a string or a cons; do not assume it is a symbol.
+(defun debug-block-fun-name (debug-block)

   (etypecase debug-block
     (compiled-debug-block
      (let ((code-locs (compiled-debug-block-code-locations debug-block)))
        (declare (simple-vector code-locs))
        (if (zerop (length code-locs))
           "??? Can't get name of debug-block's function."
   (etypecase debug-block
     (compiled-debug-block
      (let ((code-locs (compiled-debug-block-code-locations debug-block)))
        (declare (simple-vector code-locs))
        (if (zerop (length code-locs))
           "??? 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))))))
+          (debug-fun-name
+           (code-location-debug-fun (svref code-locs 0))))))
+    ;; (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
 

@@ -2409,48 +1922,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.

@@ -2459,53 +1962,181 @@
 ;;; GC, and might also arise in debug variable locations when
 ;;; those variables are invalid.)
 (defun make-valid-lisp-obj (val)
 ;;; GC, and might also arise in debug variable locations when
 ;;; 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))

   (if (or
        ;; fixnum
        (zerop (logand val 3))
        ;; character
        (and (zerop (logand val #xffff0000)) ; Top bits zero
   (if (or
        ;; fixnum
        (zerop (logand val 3))
        ;; character
        (and (zerop (logand val #xffff0000)) ; Top bits zero

-           (= (logand val #xff) sb!vm:base-char-type)) ; Char tag
+           (= (logand val #xff) sb!vm:base-char-widetag)) ; char tag

        ;; unbound marker
        ;; unbound marker

-       (= val sb!vm:unbound-marker-type)
+       (= val sb!vm:unbound-marker-widetag)

        ;; pointer
        (and (logand val 1)
            ;; Check that the pointer is valid. XXX Could do a better
            ;; job. FIXME: e.g. by calling out to an is_valid_pointer
            ;; routine in the C runtime support code
        ;; pointer
        (and (logand val 1)
            ;; Check that the pointer is valid. XXX Could do a better
            ;; job. FIXME: e.g. by calling out to an is_valid_pointer
            ;; routine in the C runtime support code

-           (or (< sb!vm:*read-only-space-start* val
+           (or (< sb!vm:read-only-space-start val

                   (* sb!vm:*read-only-space-free-pointer*
                   (* sb!vm:*read-only-space-free-pointer*

-                     sb!vm:word-bytes))
-               (< sb!vm::*static-space-start* val
+                     sb!vm:n-word-bytes))
+               (< sb!vm:static-space-start val

                   (* sb!vm:*static-space-free-pointer*
                   (* sb!vm:*static-space-free-pointer*

-                     sb!vm:word-bytes))
-               (< (sb!vm:current-dynamic-space-start) val
+                     sb!vm:n-word-bytes))
+               (< sb!vm:dynamic-space-start val

                   (sap-int (dynamic-space-free-pointer))))))
       (make-lisp-obj val)
       :invalid-object))
 
                   (sap-int (dynamic-space-free-pointer))))))
       (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 (* nfp-save-offset
+                                                          sb!vm:n-word-bytes))
+                                #!+alpha
+                                (sb!vm::make-number-stack-pointer
+                                 (sb!sys:sap-ref-32 fp (* nfp-save-offset
+                                                          sb!vm:n-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:n-word-bits) val)
+             (logior val (ash -1 sb!vm:n-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:n-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:n-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:n-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:n-word-bytes))
+          (sb!sys:sap-ref-single nfp (* (1+ (sb!c:sc-offset-offset sc-offset))
+                                        sb!vm:n-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:n-word-bytes))
+          (sb!sys:sap-ref-double nfp (* (+ (sb!c:sc-offset-offset sc-offset) 2)
+                                        sb!vm:n-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:n-word-bytes))
+          (sb!sys:sap-ref-long nfp (* (+ (sb!c:sc-offset-offset sc-offset)
+                                         #!+sparc 4)
+                                      sb!vm:n-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:n-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:n-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:n-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:n-word-bytes)))))))

 
 #!+x86
 (defun sub-access-debug-var-slot (fp sc-offset &optional escaped)
   (declare (type system-area-pointer fp))
 
 #!+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))

   (macrolet ((with-escaped-value ((var) &body forms)
               `(if escaped
                    (let ((,var (sb!vm:context-register
                                 escaped
                                 (sb!c:sc-offset-offset sc-offset))))
   (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))

                      ,@forms)
                    :invalid-value-for-unescaped-register-storage))
             (escaped-float-value (format)
                      ,@forms)
                    :invalid-value-for-unescaped-register-storage))
             (escaped-float-value (format)

@@ -2523,131 +2154,95 @@
                    :invalid-value-for-unescaped-register-storage)))
     (ecase (sb!c:sc-offset-scn sc-offset)
       ((#.sb!vm:any-reg-sc-number #.sb!vm:descriptor-reg-sc-number)
                    :invalid-value-for-unescaped-register-storage)))
     (ecase (sb!c:sc-offset-scn sc-offset)
       ((#.sb!vm:any-reg-sc-number #.sb!vm:descriptor-reg-sc-number)

-       (/show0 "case of ANY-REG-SC-NUMBER or DESCRIPTOR-REG-SC-NUMBER")

        (without-gcing
        (with-escaped-value (val)
        (without-gcing
        (with-escaped-value (val)

-         (/show0 "VAL=..")
-         #!+sb-show (%primitive print (sb!impl::hexstr val))

          (make-valid-lisp-obj val))))
       (#.sb!vm: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")

        (with-escaped-value (val)
         (code-char val)))
       (#.sb!vm:sap-reg-sc-number
        (with-escaped-value (val)
         (code-char val)))
       (#.sb!vm:sap-reg-sc-number

-       (/show0 "case of SAP-REG-SC-NUMBER")

        (with-escaped-value (val)
         (int-sap val)))
       (#.sb!vm:signed-reg-sc-number
        (with-escaped-value (val)
         (int-sap val)))
       (#.sb!vm:signed-reg-sc-number

-       (/show0 "case of SIGNED-REG-SC-NUMBER")

        (with-escaped-value (val)
        (with-escaped-value (val)

-        (if (logbitp (1- sb!vm:word-bits) val)
-            (logior val (ash -1 sb!vm:word-bits))
+        (if (logbitp (1- sb!vm:n-word-bits) val)
+            (logior val (ash -1 sb!vm:n-word-bits))

             val)))
       (#.sb!vm:unsigned-reg-sc-number
             val)))
       (#.sb!vm:unsigned-reg-sc-number

-       (/show0 "case of UNSIGNED-REG-SC-NUMBER")

        (with-escaped-value (val)
         val))
       (#.sb!vm:single-reg-sc-number
        (with-escaped-value (val)
         val))
       (#.sb!vm:single-reg-sc-number

-       (/show0 "case of SINGLE-REG-SC-NUMBER")

        (escaped-float-value single-float))
       (#.sb!vm:double-reg-sc-number
        (escaped-float-value single-float))
       (#.sb!vm:double-reg-sc-number

-       (/show0 "case of DOUBLE-REG-SC-NUMBER")

        (escaped-float-value double-float))
       #!+long-float
       (#.sb!vm:long-reg-sc-number
        (escaped-float-value double-float))
       #!+long-float
       (#.sb!vm:long-reg-sc-number

-       (/show0 "case of LONG-REG-SC-NUMBER")

        (escaped-float-value long-float))
       (#.sb!vm:complex-single-reg-sc-number
        (escaped-float-value long-float))
       (#.sb!vm:complex-single-reg-sc-number

-       (/show0 "case of COMPLEX-SINGLE-REG-SC-NUMBER")

        (escaped-complex-float-value single-float))
       (#.sb!vm:complex-double-reg-sc-number
        (escaped-complex-float-value single-float))
       (#.sb!vm:complex-double-reg-sc-number

-       (/show0 "case of COMPLEX-DOUBLE-REG-SC-NUMBER")

        (escaped-complex-float-value double-float))
       #!+long-float
       (#.sb!vm:complex-long-reg-sc-number
        (escaped-complex-float-value double-float))
       #!+long-float
       (#.sb!vm:complex-long-reg-sc-number

-       (/show0 "case of COMPLEX-LONG-REG-SC-NUMBER")

        (escaped-complex-float-value long-float))
       (#.sb!vm:single-stack-sc-number
        (escaped-complex-float-value long-float))
       (#.sb!vm:single-stack-sc-number

-       (/show0 "case of SINGLE-STACK-SC-NUMBER")

        (sap-ref-single fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
        (sap-ref-single fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))

-                               sb!vm:word-bytes))))
+                               sb!vm:n-word-bytes))))

       (#.sb!vm:double-stack-sc-number
       (#.sb!vm:double-stack-sc-number

-       (/show0 "case of DOUBLE-STACK-SC-NUMBER")

        (sap-ref-double fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2)
        (sap-ref-double fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2)

-                               sb!vm:word-bytes))))
+                               sb!vm:n-word-bytes))))

       #!+long-float
       (#.sb!vm:long-stack-sc-number
       #!+long-float
       (#.sb!vm:long-stack-sc-number

-       (/show0 "case of LONG-STACK-SC-NUMBER")

        (sap-ref-long fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 3)
        (sap-ref-long fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 3)

-                             sb!vm:word-bytes))))
+                             sb!vm:n-word-bytes))))

       (#.sb!vm:complex-single-stack-sc-number
       (#.sb!vm:complex-single-stack-sc-number

-       (/show0 "case of COMPLEX-STACK-SC-NUMBER")

        (complex
        (sap-ref-single fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
        (complex
        (sap-ref-single fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))

-                                sb!vm:word-bytes)))
+                                sb!vm:n-word-bytes)))

        (sap-ref-single fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2)
        (sap-ref-single fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2)

-                                sb!vm:word-bytes)))))
+                                sb!vm:n-word-bytes)))))

       (#.sb!vm:complex-double-stack-sc-number
       (#.sb!vm:complex-double-stack-sc-number

-       (/show0 "case of COMPLEX-DOUBLE-STACK-SC-NUMBER")

        (complex
        (sap-ref-double fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2)
        (complex
        (sap-ref-double fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2)

-                                sb!vm:word-bytes)))
+                                sb!vm:n-word-bytes)))

        (sap-ref-double fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 4)
        (sap-ref-double fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 4)

-                                sb!vm:word-bytes)))))
+                                sb!vm:n-word-bytes)))))

       #!+long-float
       (#.sb!vm:complex-long-stack-sc-number
       #!+long-float
       (#.sb!vm:complex-long-stack-sc-number

-       (/show0 "case of COMPLEX-LONG-STACK-SC-NUMBER")

        (complex
        (sap-ref-long fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 3)
        (complex
        (sap-ref-long fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 3)

-                              sb!vm:word-bytes)))
+                              sb!vm:n-word-bytes)))

        (sap-ref-long fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 6)
        (sap-ref-long fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 6)

-                              sb!vm:word-bytes)))))
+                              sb!vm:n-word-bytes)))))

       (#.sb!vm:control-stack-sc-number
       (#.sb!vm:control-stack-sc-number

-       (/show0 "case of CONTROL-STACK-SC-NUMBER")

        (stack-ref fp (sb!c:sc-offset-offset sc-offset)))
       (#.sb!vm:base-char-stack-sc-number
        (stack-ref fp (sb!c:sc-offset-offset sc-offset)))
       (#.sb!vm:base-char-stack-sc-number

-       (/show0 "case of BASE-CHAR-STACK-SC-NUMBER")

        (code-char
        (sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
        (code-char
        (sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))

-                            sb!vm:word-bytes)))))
+                            sb!vm:n-word-bytes)))))

       (#.sb!vm:unsigned-stack-sc-number
       (#.sb!vm:unsigned-stack-sc-number

-       (/show0 "case of UNSIGNED-STACK-SC-NUMBER")

        (sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
        (sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))

-                           sb!vm:word-bytes))))
+                           sb!vm:n-word-bytes))))

       (#.sb!vm:signed-stack-sc-number
       (#.sb!vm:signed-stack-sc-number

-       (/show0 "case of SIGNED-STACK-SC-NUMBER")

        (signed-sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
        (signed-sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))

-                                  sb!vm:word-bytes))))
+                                  sb!vm:n-word-bytes))))

       (#.sb!vm:sap-stack-sc-number
       (#.sb!vm:sap-stack-sc-number

-       (/show0 "case of SAP-STACK-SC-NUMBER")

        (sap-ref-sap fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
        (sap-ref-sap fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))

-                            sb!vm:word-bytes)))))))
+                            sb!vm:n-word-bytes)))))))

 
 ;;; 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.

@@ -2687,13 +2282,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))
+                                            (* nfp-save-offset
+                                               sb!vm:n-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))))))
+                                            (* nfp-save-offset
+                                               sb!vm:n-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

@@ -2707,7 +2302,7 @@
       (#.sb!vm:sap-reg-sc-number
        (set-escaped-value (sap-int value)))
       (#.sb!vm:signed-reg-sc-number
       (#.sb!vm:sap-reg-sc-number
        (set-escaped-value (sap-int value)))
       (#.sb!vm:signed-reg-sc-number

-       (set-escaped-value (logand value (1- (ash 1 sb!vm:word-bits)))))
+       (set-escaped-value (logand value (1- (ash 1 sb!vm:n-word-bits)))))

       (#.sb!vm:unsigned-reg-sc-number
        (set-escaped-value value))
       (#.sb!vm:non-descriptor-reg-sc-number
       (#.sb!vm:unsigned-reg-sc-number
        (set-escaped-value value))
       (#.sb!vm:non-descriptor-reg-sc-number

@@ -2758,68 +2353,68 @@
       (#.sb!vm:single-stack-sc-number
        (with-nfp (nfp)
         (setf (sap-ref-single nfp (* (sb!c:sc-offset-offset sc-offset)
       (#.sb!vm:single-stack-sc-number
        (with-nfp (nfp)
         (setf (sap-ref-single nfp (* (sb!c:sc-offset-offset sc-offset)

-                                     sb!vm:word-bytes))
+                                     sb!vm:n-word-bytes))

               (the single-float value))))
       (#.sb!vm:double-stack-sc-number
        (with-nfp (nfp)
         (setf (sap-ref-double nfp (* (sb!c:sc-offset-offset sc-offset)
               (the single-float value))))
       (#.sb!vm:double-stack-sc-number
        (with-nfp (nfp)
         (setf (sap-ref-double nfp (* (sb!c:sc-offset-offset sc-offset)

-                                     sb!vm:word-bytes))
+                                     sb!vm:n-word-bytes))

               (the double-float value))))
       #!+long-float
       (#.sb!vm:long-stack-sc-number
        (with-nfp (nfp)
         (setf (sap-ref-long nfp (* (sb!c:sc-offset-offset sc-offset)
               (the double-float value))))
       #!+long-float
       (#.sb!vm:long-stack-sc-number
        (with-nfp (nfp)
         (setf (sap-ref-long nfp (* (sb!c:sc-offset-offset sc-offset)

-                                   sb!vm:word-bytes))
+                                   sb!vm:n-word-bytes))

               (the long-float value))))
       (#.sb!vm:complex-single-stack-sc-number
        (with-nfp (nfp)
         (setf (sap-ref-single
               (the long-float value))))
       (#.sb!vm:complex-single-stack-sc-number
        (with-nfp (nfp)
         (setf (sap-ref-single

-               nfp (* (sb!c:sc-offset-offset sc-offset) sb!vm:word-bytes))
+               nfp (* (sb!c:sc-offset-offset sc-offset) sb!vm:n-word-bytes))

               (the single-float (realpart value)))
         (setf (sap-ref-single
                nfp (* (1+ (sb!c:sc-offset-offset sc-offset))
               (the single-float (realpart value)))
         (setf (sap-ref-single
                nfp (* (1+ (sb!c:sc-offset-offset sc-offset))

-                      sb!vm:word-bytes))
+                      sb!vm:n-word-bytes))

               (the single-float (realpart value)))))
       (#.sb!vm:complex-double-stack-sc-number
        (with-nfp (nfp)
         (setf (sap-ref-double
               (the single-float (realpart value)))))
       (#.sb!vm:complex-double-stack-sc-number
        (with-nfp (nfp)
         (setf (sap-ref-double

-               nfp (* (sb!c:sc-offset-offset sc-offset) sb!vm:word-bytes))
+               nfp (* (sb!c:sc-offset-offset sc-offset) sb!vm:n-word-bytes))

               (the double-float (realpart value)))
         (setf (sap-ref-double
                nfp (* (+ (sb!c:sc-offset-offset sc-offset) 2)
               (the double-float (realpart value)))
         (setf (sap-ref-double
                nfp (* (+ (sb!c:sc-offset-offset sc-offset) 2)

-                      sb!vm:word-bytes))
+                      sb!vm:n-word-bytes))

               (the double-float (realpart value)))))
       #!+long-float
       (#.sb!vm:complex-long-stack-sc-number
        (with-nfp (nfp)
         (setf (sap-ref-long
               (the double-float (realpart value)))))
       #!+long-float
       (#.sb!vm:complex-long-stack-sc-number
        (with-nfp (nfp)
         (setf (sap-ref-long

-               nfp (* (sb!c:sc-offset-offset sc-offset) sb!vm:word-bytes))
+               nfp (* (sb!c:sc-offset-offset sc-offset) sb!vm:n-word-bytes))

               (the long-float (realpart value)))
         (setf (sap-ref-long
                nfp (* (+ (sb!c:sc-offset-offset sc-offset) #!+sparc 4)
               (the long-float (realpart value)))
         (setf (sap-ref-long
                nfp (* (+ (sb!c:sc-offset-offset sc-offset) #!+sparc 4)

-                      sb!vm:word-bytes))
+                      sb!vm:n-word-bytes))

               (the long-float (realpart value)))))
       (#.sb!vm:control-stack-sc-number
        (setf (stack-ref fp (sb!c:sc-offset-offset sc-offset)) value))
       (#.sb!vm:base-char-stack-sc-number
        (with-nfp (nfp)
         (setf (sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset)
               (the long-float (realpart value)))))
       (#.sb!vm:control-stack-sc-number
        (setf (stack-ref fp (sb!c:sc-offset-offset sc-offset)) value))
       (#.sb!vm:base-char-stack-sc-number
        (with-nfp (nfp)
         (setf (sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset)

-                                        sb!vm:word-bytes))
+                                        sb!vm:n-word-bytes))

               (char-code (the character value)))))
       (#.sb!vm:unsigned-stack-sc-number
        (with-nfp (nfp)
         (setf (sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset)
               (char-code (the character value)))))
       (#.sb!vm:unsigned-stack-sc-number
        (with-nfp (nfp)
         (setf (sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset)

-                                 sb!vm:word-bytes))
+                                 sb!vm:n-word-bytes))

               (the (unsigned-byte 32) value))))
       (#.sb!vm:signed-stack-sc-number
        (with-nfp (nfp)
         (setf (signed-sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset)
               (the (unsigned-byte 32) value))))
       (#.sb!vm:signed-stack-sc-number
        (with-nfp (nfp)
         (setf (signed-sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset)

-                                        sb!vm:word-bytes))
+                                        sb!vm:n-word-bytes))

               (the (signed-byte 32) value))))
       (#.sb!vm:sap-stack-sc-number
        (with-nfp (nfp)
         (setf (sap-ref-sap nfp (* (sb!c:sc-offset-offset sc-offset)
               (the (signed-byte 32) value))))
       (#.sb!vm:sap-stack-sc-number
        (with-nfp (nfp)
         (setf (sap-ref-sap nfp (* (sb!c:sc-offset-offset sc-offset)

-                                  sb!vm:word-bytes))
+                                  sb!vm:n-word-bytes))

               (the system-area-pointer value)))))))
 
 #!+x86
               (the system-area-pointer value)))))))
 
 #!+x86

@@ -2841,7 +2436,7 @@
       (#.sb!vm:sap-reg-sc-number
        (set-escaped-value (sap-int value)))
       (#.sb!vm:signed-reg-sc-number
       (#.sb!vm:sap-reg-sc-number
        (set-escaped-value (sap-int value)))
       (#.sb!vm:signed-reg-sc-number

-       (set-escaped-value (logand value (1- (ash 1 sb!vm:word-bits)))))
+       (set-escaped-value (logand value (1- (ash 1 sb!vm:n-word-bits)))))

       (#.sb!vm:unsigned-reg-sc-number
        (set-escaped-value value))
       (#.sb!vm:single-reg-sc-number
       (#.sb!vm:unsigned-reg-sc-number
        (set-escaped-value value))
       (#.sb!vm:single-reg-sc-number

@@ -2857,119 +2452,117 @@
       (#.sb!vm:single-stack-sc-number
        (setf (sap-ref-single
              fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
       (#.sb!vm:single-stack-sc-number
        (setf (sap-ref-single
              fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))

-                      sb!vm:word-bytes)))
+                      sb!vm:n-word-bytes)))

             (the single-float value)))
       (#.sb!vm:double-stack-sc-number
        (setf (sap-ref-double
              fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2)
             (the single-float value)))
       (#.sb!vm:double-stack-sc-number
        (setf (sap-ref-double
              fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2)

-                      sb!vm:word-bytes)))
+                      sb!vm:n-word-bytes)))

             (the double-float value)))
       #!+long-float
       (#.sb!vm:long-stack-sc-number
        (setf (sap-ref-long
              fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 3)
             (the double-float value)))
       #!+long-float
       (#.sb!vm:long-stack-sc-number
        (setf (sap-ref-long
              fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 3)

-                      sb!vm:word-bytes)))
+                      sb!vm:n-word-bytes)))

             (the long-float value)))
       (#.sb!vm:complex-single-stack-sc-number
        (setf (sap-ref-single
              fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
             (the long-float value)))
       (#.sb!vm:complex-single-stack-sc-number
        (setf (sap-ref-single
              fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))

-                      sb!vm:word-bytes)))
+                      sb!vm:n-word-bytes)))

             (realpart (the (complex single-float) value)))
        (setf (sap-ref-single
              fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2)
             (realpart (the (complex single-float) value)))
        (setf (sap-ref-single
              fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2)

-                      sb!vm:word-bytes)))
+                      sb!vm:n-word-bytes)))

             (imagpart (the (complex single-float) value))))
       (#.sb!vm:complex-double-stack-sc-number
        (setf (sap-ref-double
              fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2)
             (imagpart (the (complex single-float) value))))
       (#.sb!vm:complex-double-stack-sc-number
        (setf (sap-ref-double
              fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2)

-                      sb!vm:word-bytes)))
+                      sb!vm:n-word-bytes)))

             (realpart (the (complex double-float) value)))
        (setf (sap-ref-double
              fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 4)
             (realpart (the (complex double-float) value)))
        (setf (sap-ref-double
              fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 4)

-                      sb!vm:word-bytes)))
+                      sb!vm:n-word-bytes)))

             (imagpart (the (complex double-float) value))))
       #!+long-float
       (#.sb!vm:complex-long-stack-sc-number
        (setf (sap-ref-long
              fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 3)
             (imagpart (the (complex double-float) value))))
       #!+long-float
       (#.sb!vm:complex-long-stack-sc-number
        (setf (sap-ref-long
              fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 3)

-                      sb!vm:word-bytes)))
+                      sb!vm:n-word-bytes)))

             (realpart (the (complex long-float) value)))
        (setf (sap-ref-long
              fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 6)
             (realpart (the (complex long-float) value)))
        (setf (sap-ref-long
              fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 6)

-                      sb!vm:word-bytes)))
+                      sb!vm:n-word-bytes)))

             (imagpart (the (complex long-float) value))))
       (#.sb!vm:control-stack-sc-number
        (setf (stack-ref fp (sb!c:sc-offset-offset sc-offset)) value))
       (#.sb!vm:base-char-stack-sc-number
        (setf (sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
             (imagpart (the (complex long-float) value))))
       (#.sb!vm:control-stack-sc-number
        (setf (stack-ref fp (sb!c:sc-offset-offset sc-offset)) value))
       (#.sb!vm:base-char-stack-sc-number
        (setf (sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))

-                                        sb!vm:word-bytes)))
+                                        sb!vm:n-word-bytes)))

             (char-code (the character value))))
       (#.sb!vm:unsigned-stack-sc-number
        (setf (sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
             (char-code (the character value))))
       (#.sb!vm:unsigned-stack-sc-number
        (setf (sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))

-                                        sb!vm:word-bytes)))
+                                        sb!vm:n-word-bytes)))

             (the (unsigned-byte 32) value)))
       (#.sb!vm:signed-stack-sc-number
        (setf (signed-sap-ref-32
             (the (unsigned-byte 32) value)))
       (#.sb!vm:signed-stack-sc-number
        (setf (signed-sap-ref-32

-             fp (- (* (1+ (sb!c:sc-offset-offset sc-offset)) sb!vm:word-bytes)))
+             fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
+                      sb!vm:n-word-bytes)))

             (the (signed-byte 32) value)))
       (#.sb!vm:sap-stack-sc-number
        (setf (sap-ref-sap fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
             (the (signed-byte 32) value)))
       (#.sb!vm:sap-stack-sc-number
        (setf (sap-ref-sap fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))

-                                         sb!vm:word-bytes)))
+                                         sb!vm:n-word-bytes)))

             (the system-area-pointer value))))))
 
 ;;; The method for setting and accessing COMPILED-DEBUG-VAR values use
 ;;; this to determine if the value stored is the actual value or an
 ;;; indirection cell.
 (defun indirect-value-cell-p (x)
             (the system-area-pointer value))))))
 
 ;;; The method for setting and accessing COMPILED-DEBUG-VAR values use
 ;;; this to determine if the value stored is the actual value or an
 ;;; indirection cell.
 (defun indirect-value-cell-p (x)

-  (and (= (get-lowtag x) sb!vm:other-pointer-type)
-       (= (get-type x) sb!vm:value-cell-header-type)))
-
+  (and (= (lowtag-of x) sb!vm:other-pointer-lowtag)
+       (= (widetag-of x) sb!vm:value-cell-header-widetag)))
+
+;;; 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)
   (cond ((debug-var-alive-p debug-var)

-        (let ((debug-fun (code-location-debug-function basic-code-location)))
+        (let ((debug-fun (code-location-debug-fun basic-code-location)))

           (if (>= (compiled-code-location-pc basic-code-location)
           (if (>= (compiled-code-location-pc basic-code-location)

-                  (sb!c::compiled-debug-function-start-pc
-                   (compiled-debug-function-compiler-debug-fun debug-fun)))
+                  (sb!c::compiled-debug-fun-start-pc
+                   (compiled-debug-fun-compiler-debug-fun debug-fun)))

               :valid
               :invalid)))
        ((code-location-unknown-p basic-code-location) :unknown)
        (t
         (let ((pos (position debug-var
               :valid
               :invalid)))
        ((code-location-unknown-p basic-code-location) :unknown)
        (t
         (let ((pos (position debug-var

-                             (debug-function-debug-vars
-                              (code-location-debug-function basic-code-location)))))
+                             (debug-fun-debug-vars
+                              (code-location-debug-fun
+                               basic-code-location)))))

           (unless pos
             (error 'unknown-debug-var
                    :debug-var debug-var
           (unless pos
             (error 'unknown-debug-var
                    :debug-var debug-var

-                   :debug-function
-                   (code-location-debug-function basic-code-location)))
+                   :debug-fun
+                   (code-location-debug-fun basic-code-location)))

           ;; There must be live-set info since basic-code-location is known.
           ;; 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)))))

@@ -2979,35 +2572,35 @@
 ;;; This code produces and uses what we call source-paths. A
 ;;; source-path is a list whose first element is a form number as
 ;;; returned by CODE-LOCATION-FORM-NUMBER and whose last element is a
 ;;; This code produces and uses what we call source-paths. A
 ;;; source-path is a list whose first element is a form number as
 ;;; returned by CODE-LOCATION-FORM-NUMBER and whose last element is a

-;;; top-level-form number as returned by
-;;; CODE-LOCATION-TOP-LEVEL-FORM-NUMBER. The elements from the last to
+;;; top level form number as returned by
+;;; CODE-LOCATION-TOPLEVEL-FORM-NUMBER. The elements from the last to

 ;;; the first, exclusively, are the numbered subforms into which to
 ;;; descend. For example:
 ;;;    (defun foo (x)
 ;;;      (let ((a (aref x 3)))
 ;;;    (cons a 3)))
 ;;; The call to AREF in this example is form number 5. Assuming this
 ;;; the first, exclusively, are the numbered subforms into which to
 ;;; descend. For example:
 ;;;    (defun foo (x)
 ;;;      (let ((a (aref x 3)))
 ;;;    (cons a 3)))
 ;;; The call to AREF in this example is form number 5. Assuming this

-;;; DEFUN is the 11'th top-level-form, the source-path for the AREF
+;;; DEFUN is the 11'th top level form, the source-path for the AREF

 ;;; call is as follows:
 ;;;    (5 1 0 1 3 11)
 ;;; Given the DEFUN, 3 gets you the LET, 1 gets you the bindings, 0
 ;;; gets the first binding, and 1 gets the AREF form.
 
 ;;; call is as follows:
 ;;;    (5 1 0 1 3 11)
 ;;; 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 TOPLEVEL-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 TOPLEVEL-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))

@@ -3035,13 +2628,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.

@@ -3071,27 +2664,26 @@
                              (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-FUN 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-VAR-NAME, and FRAME-FUN-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))
   (declare (type code-location loc))
   (let ((n-frame (gensym))

-       (fun (code-location-debug-function loc)))
+       (fun (code-location-debug-fun loc)))

     (unless (debug-var-info-available fun)
     (unless (debug-var-info-available fun)

-      (debug-signal 'no-debug-vars :debug-function fun))
+      (debug-signal 'no-debug-vars :debug-fun fun))

     (sb!int:collect ((binds)
                     (specs))
     (sb!int:collect ((binds)
                     (specs))

-      (do-debug-function-variables (var fun)
+      (do-debug-fun-variables (var fun)

        (let ((validity (debug-var-validity var loc)))
          (unless (eq validity :invalid)
            (let* ((sym (debug-var-symbol var))
        (let ((validity (debug-var-validity var loc)))
          (unless (eq validity :invalid)
            (let* ((sym (debug-var-symbol var))

@@ -3106,10 +2698,12 @@
            (:valid
             (specs `(,name (debug-var-value ',var ,n-frame))))
            (:unknown
            (:valid
             (specs `(,name (debug-var-value ',var ,n-frame))))
            (:unknown

-            (specs `(,name (debug-signal 'invalid-value :debug-var ',var
+            (specs `(,name (debug-signal 'invalid-value
+                                         :debug-var ',var

                                          :frame ,n-frame))))
            (:ambiguous
                                          :frame ,n-frame))))
            (:ambiguous

-            (specs `(,name (debug-signal 'ambiguous-variable-name :name ',name
+            (specs `(,name (debug-signal 'ambiguous-var-name
+                                         :name ',name

                                          :frame ,n-frame)))))))
       (let ((res (coerce `(lambda (,n-frame)
                            (declare (ignorable ,n-frame))
                                          :frame ,n-frame)))))))
       (let ((res (coerce `(lambda (,n-frame)
                            (declare (ignorable ,n-frame))

@@ -3119,59 +2713,55 @@
            ;; This prevents these functions from being used in any
            ;; location other than a function return location, so
            ;; maybe this should only check whether frame's
            ;; This prevents these functions from being used in any
            ;; location other than a function return location, so
            ;; maybe this should only check whether frame's

-           ;; debug-function is the same as loc's.
+           ;; DEBUG-FUN is the same as loc's.

            (unless (code-location= (frame-code-location frame) loc)
            (unless (code-location= (frame-code-location frame) loc)

-             (debug-signal 'frame-function-mismatch
+             (debug-signal 'frame-fun-mismatch

                            :code-location loc :form form :frame frame))
            (funcall res frame))))))
                            :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-FUN.
+;;; KIND is one of :CODE-LOCATION, :FUN-START, or :FUN-END.
+;;; Since the starts and ends of functions may not have code-locations
+;;; representing them, designate these places by supplying WHAT as a
+;;; DEBUG-FUN and KIND indicating the :FUN-START or
+;;; :FUN-END. When WHAT is a DEBUG-FUN and kind is
+;;; :FUN-END, then hook-function must take two additional
+;;; arguments, a list of values returned by the function and a
+;;; FUN-END-COOKIE.
+;;;
+;;; INFO is information supplied by and used by the user.
+;;;
+;;; FUN-END-COOKIE is a function. To implement :FUN-END
+;;; breakpoints, the system uses starter breakpoints to establish the
+;;; :FUN-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 :FUN-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
 (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."
+                       &key (kind :code-location) info fun-end-cookie)

   (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)

@@ -3179,78 +2769,78 @@
                                               :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))
        bpt))

-    (compiled-debug-function
+    (compiled-debug-fun

      (ecase kind
      (ecase kind

-       (:function-start
+       (:fun-start

        (%make-breakpoint hook-function what kind info))
        (%make-breakpoint hook-function what kind info))

-       (:function-end
-       (unless (eq (sb!c::compiled-debug-function-returns
-                    (compiled-debug-function-compiler-debug-fun what))
+       (:fun-end
+       (unless (eq (sb!c::compiled-debug-fun-returns
+                    (compiled-debug-fun-compiler-debug-fun what))

                    :standard)
                    :standard)

-         (error ":FUNCTION-END breakpoints are currently unsupported ~
+         (error ":FUN-END breakpoints are currently unsupported ~

                  for the known return convention."))
 
        (let* ((bpt (%make-breakpoint hook-function what kind info))
                  for the known return convention."))
 
        (let* ((bpt (%make-breakpoint hook-function what kind info))

-              (starter (compiled-debug-function-end-starter what)))
+              (starter (compiled-debug-fun-end-starter what)))

          (unless starter
          (unless starter

-           (setf starter (%make-breakpoint #'list what :function-start nil))
+           (setf starter (%make-breakpoint #'list what :fun-start nil))

            (setf (breakpoint-hook-function starter)
            (setf (breakpoint-hook-function starter)

-                 (function-end-starter-hook starter what))
-           (setf (compiled-debug-function-end-starter what) starter))
+                 (fun-end-starter-hook starter what))
+           (setf (compiled-debug-fun-end-starter what) starter))

          (setf (breakpoint-start-helper bpt) starter)
          (push bpt (breakpoint-%info starter))
          (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."))))
+         (setf (breakpoint-cookie-fun bpt) fun-end-cookie)
+         bpt))))))

 
 ;;; These are unique objects created upon entry into a function by a
 
 ;;; These are unique objects created upon entry into a function by a

-;;; :FUNCTION-END breakpoint's starter hook. These are only created
-;;; when users supply :FUNCTION-END-COOKIE to MAKE-BREAKPOINT. Also,
-;;; the :FUNCTION-END breakpoint's hook is called on the same cookie
+;;; :FUN-END breakpoint's starter hook. These are only created
+;;; when users supply :FUN-END-COOKIE to MAKE-BREAKPOINT. Also,
+;;; the :FUN-END breakpoint's hook is called on the same cookie

 ;;; when it is created.
 ;;; when it is created.

-(defstruct (function-end-cookie
+(defstruct (fun-end-cookie

            (:print-object (lambda (obj str)
                             (print-unreadable-object (obj str :type t))))
            (: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-fun-end-cookie (bogus-lra debug-fun))
+           (:copier nil))
+  ;; a pointer to the bogus-lra created for :FUN-END breakpoints

   bogus-lra
   bogus-lra

-  ;; This is the debug-function associated with the cookie.
+  ;; the DEBUG-FUN associated with this cookie

   debug-fun)
 
   debug-fun)
 

-;;; This maps bogus-lra-components to cookies, so
-;;; HANDLE-FUNCTION-END-BREAKPOINT can find the appropriate cookie for the
+;;; This maps bogus-lra-components to cookies, so that
+;;; HANDLE-FUN-END-BREAKPOINT can find the appropriate cookie for the

 ;;; breakpoint hook.
 ;;; breakpoint hook.

-(defvar *function-end-cookies* (make-hash-table :test 'eq))
+(defvar *fun-end-cookies* (make-hash-table :test 'eq))

 
 ;;; This returns a hook function for the start helper breakpoint
 
 ;;; This returns a hook function for the start helper breakpoint

-;;; associated with a :FUNCTION-END breakpoint. The returned function
+;;; associated with a :FUN-END breakpoint. The returned function

 ;;; makes a fake LRA that all returns go through, and this piece of
 ;;; fake code actually breaks. Upon return from the break, the code
 ;;; provides the returnee with any values. Since the returned function
 ;;; effectively activates FUN-END-BPT on each entry to DEBUG-FUN's
 ;;; function, we must establish breakpoint-data about FUN-END-BPT.
 ;;; makes a fake LRA that all returns go through, and this piece of
 ;;; fake code actually breaks. Upon return from the break, the code
 ;;; provides the returnee with any values. Since the returned function
 ;;; effectively activates FUN-END-BPT on each entry to DEBUG-FUN's
 ;;; function, we must establish breakpoint-data about FUN-END-BPT.

-(defun function-end-starter-hook (starter-bpt debug-fun)
+(defun fun-end-starter-hook (starter-bpt debug-fun)

   (declare (type breakpoint starter-bpt)
   (declare (type breakpoint starter-bpt)

-          (type compiled-debug-function debug-fun))
+          (type compiled-debug-fun debug-fun))

   #'(lambda (frame breakpoint)
       (declare (ignore breakpoint)
               (type frame frame))
       (let ((lra-sc-offset
   #'(lambda (frame breakpoint)
       (declare (ignore breakpoint)
               (type frame frame))
       (let ((lra-sc-offset

-            (sb!c::compiled-debug-function-return-pc
-             (compiled-debug-function-compiler-debug-fun debug-fun))))
+            (sb!c::compiled-debug-fun-return-pc
+             (compiled-debug-fun-compiler-debug-fun debug-fun))))

        (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
+                               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
+                                  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)))

@@ -3258,43 +2848,42 @@
              (setf (breakpoint-data-breakpoints data) end-bpts)
              (dolist (bpt end-bpts)
                (setf (breakpoint-internal-data bpt) data)))
              (setf (breakpoint-data-breakpoints data) end-bpts)
              (dolist (bpt end-bpts)
                (setf (breakpoint-internal-data bpt) data)))

-           (let ((cookie (make-function-end-cookie lra debug-fun)))
-             (setf (gethash component *function-end-cookies*) cookie)
+           (let ((cookie (make-fun-end-cookie lra debug-fun)))
+             (setf (gethash component *fun-end-cookies*) cookie)

              (dolist (bpt end-bpts)
                (let ((fun (breakpoint-cookie-fun bpt)))
                  (when fun (funcall fun frame cookie))))))))))
 
              (dolist (bpt end-bpts)
                (let ((fun (breakpoint-cookie-fun bpt)))
                  (when fun (funcall fun 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
-                        (function-end-cookie-debug-fun cookie)))))
+;;; This takes a FUN-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
+;;; :FUN-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 fun-end-cookie-valid-p (frame cookie)
+  (let ((lra (fun-end-cookie-bogus-lra cookie))
+       (lra-sc-offset (sb!c::compiled-debug-fun-return-pc
+                       (compiled-debug-fun-compiler-debug-fun
+                        (fun-end-cookie-debug-fun cookie)))))

     (do ((frame frame (frame-down frame)))
        ((not frame) nil)
       (when (and (compiled-frame-p frame)
     (do ((frame frame (frame-down frame)))
        ((not frame) nil)
       (when (and (compiled-frame-p frame)

-                (eq lra
-                    (get-context-value frame
-                                       #!-gengc sb!vm::lra-save-offset
-                                       #!+gengc sb!vm::ra-save-offset
-                                       lra-sc-offset)))
+                 (#-x86 eq #+x86 sap=
+                 lra
+                 (get-context-value frame lra-save-offset lra-sc-offset)))

        (return t)))))
        (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)

@@ -3302,31 +2891,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)))))))
-      (:function-start
+               (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.)
+          )))
+      (:fun-start

        (etypecase (breakpoint-what breakpoint)
        (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)))))
-      (:function-end
+        (compiled-debug-fun
+         (activate-compiled-fun-start-breakpoint breakpoint))
+        ;; (There used to be more cases back before sbcl-0.7.0, when
+        ;; we did special tricks to debug the IR1 interpreter.)
+        ))
+      (:fun-end

        (etypecase (breakpoint-what breakpoint)
        (etypecase (breakpoint-what breakpoint)

-        (compiled-debug-function
+        (compiled-debug-fun

          (let ((starter (breakpoint-start-helper breakpoint)))
            (unless (eq (breakpoint-status starter) :active)
          (let ((starter (breakpoint-start-helper breakpoint)))
            (unless (eq (breakpoint-status starter) :active)

-             ;; May already be active by some other :function-end breakpoint.
-             (activate-compiled-function-start-breakpoint starter)))
+             ;; may already be active by some other :FUN-END breakpoint
+             (activate-compiled-fun-start-breakpoint starter)))

          (setf (breakpoint-status breakpoint) :active))
          (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)

@@ -3335,8 +2925,8 @@
     (declare (type compiled-code-location loc))
     (sub-activate-breakpoint
      breakpoint
     (declare (type compiled-code-location loc))
     (sub-activate-breakpoint
      breakpoint

-     (breakpoint-data (compiled-debug-function-component
-                      (code-location-debug-function loc))
+     (breakpoint-data (compiled-debug-fun-component
+                      (code-location-debug-fun loc))

                      (+ (compiled-code-location-pc loc)
                         (if (or (eq (breakpoint-kind breakpoint)
                                     :unknown-return-partner)
                      (+ (compiled-code-location-pc loc)
                         (if (or (eq (breakpoint-kind breakpoint)
                                     :unknown-return-partner)

@@ -3345,14 +2935,14 @@
                             sb!vm:single-value-return-byte-offset
                             0))))))
 
                             sb!vm:single-value-return-byte-offset
                             0))))))
 

-(defun activate-compiled-function-start-breakpoint (breakpoint)
+(defun activate-compiled-fun-start-breakpoint (breakpoint)

   (declare (type breakpoint breakpoint))
   (let ((debug-fun (breakpoint-what breakpoint)))
     (sub-activate-breakpoint
      breakpoint
   (declare (type breakpoint breakpoint))
   (let ((debug-fun (breakpoint-what breakpoint)))
     (sub-activate-breakpoint
      breakpoint

-     (breakpoint-data (compiled-debug-function-component debug-fun)
-                     (sb!c::compiled-debug-function-start-pc
-                      (compiled-debug-function-compiler-debug-fun
+     (breakpoint-data (compiled-debug-fun-component debug-fun)
+                     (sb!c::compiled-debug-fun-start-pc
+                      (compiled-debug-fun-compiler-debug-fun

                        debug-fun))))))
 
 (defun sub-activate-breakpoint (breakpoint data)
                        debug-fun))))))
 
 (defun sub-activate-breakpoint (breakpoint data)

@@ -3369,28 +2959,27 @@
    (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)
+        ((or compiled-code-location compiled-debug-fun)

          (deactivate-compiled-breakpoint breakpoint)
          (let ((other (breakpoint-unknown-return-partner breakpoint)))
            (when other
          (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)

-  (if (eq (breakpoint-kind breakpoint) :function-end)
+  (if (eq (breakpoint-kind breakpoint) :fun-end)

       (let ((starter (breakpoint-start-helper breakpoint)))
        (unless (find-if #'(lambda (bpt)
                             (and (not (eq bpt breakpoint))
       (let ((starter (breakpoint-start-helper breakpoint)))
        (unless (find-if #'(lambda (bpt)
                             (and (not (eq bpt breakpoint))

@@ -3410,34 +2999,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)

@@ -3446,18 +3031,18 @@
       (let ((other (breakpoint-unknown-return-partner breakpoint)))
        (when other
          (setf (breakpoint-status other) :deleted)))
       (let ((other (breakpoint-unknown-return-partner breakpoint)))
        (when other
          (setf (breakpoint-status other) :deleted)))

-      (when (eq (breakpoint-kind breakpoint) :function-end)
+      (when (eq (breakpoint-kind breakpoint) :fun-end)

        (let* ((starter (breakpoint-start-helper breakpoint))
               (breakpoints (delete breakpoint
                                    (the list (breakpoint-info starter)))))
          (setf (breakpoint-info starter) breakpoints)
          (unless breakpoints
            (delete-breakpoint starter)
        (let* ((starter (breakpoint-start-helper breakpoint))
               (breakpoints (delete breakpoint
                                    (the list (breakpoint-info starter)))))
          (setf (breakpoint-info starter) breakpoints)
          (unless breakpoints
            (delete-breakpoint starter)

-           (setf (compiled-debug-function-end-starter
+           (setf (compiled-debug-fun-end-starter

                   (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

@@ -3482,10 +3067,10 @@
 
 ;;;; breakpoint handlers (layer between C and exported interface)
 
 
 ;;;; breakpoint handlers (layer between C and exported interface)
 

-;;; This maps components to a mapping of offsets to breakpoint-datas.
+;;; This maps components to a mapping of offsets to BREAKPOINT-DATAs.

 (defvar *component-breakpoint-offsets* (make-hash-table :test 'eq))
 
 (defvar *component-breakpoint-offsets* (make-hash-table :test 'eq))
 

-;;; This returns the breakpoint-data associated with component cross
+;;; This returns the BREAKPOINT-DATA object associated with component cross

 ;;; offset. If none exists, this makes one, installs it, and returns it.
 (defun breakpoint-data (component offset &optional (create t))
   (flet ((install-breakpoint-data ()
 ;;; offset. If none exists, this makes one, installs it, and returns it.
 (defun breakpoint-data (component offset &optional (create t))
   (flet ((install-breakpoint-data ()

@@ -3503,7 +3088,7 @@
          (install-breakpoint-data)))))
 
 ;;; We use this when there are no longer any active breakpoints
          (install-breakpoint-data)))))
 
 ;;; We use this when there are no longer any active breakpoints

-;;; corresponding to data.
+;;; corresponding to DATA.

 (defun delete-breakpoint-data (data)
   (let* ((component (breakpoint-data-component data))
         (offsets (delete (breakpoint-data-offset data)
 (defun delete-breakpoint-data (data)
   (let* ((component (breakpoint-data-component data))
         (offsets (delete (breakpoint-data-offset data)

@@ -3515,30 +3100,31 @@
   (values))
 
 ;;; The C handler for interrupts calls this when it has a
   (values))
 
 ;;; The C handler for interrupts calls this when it has a

-;;; debugging-tool break instruction. This does NOT handle all breaks;
-;;; for example, it does not handle breaks for internal errors.
+;;; debugging-tool break instruction. This does *not* handle all
+;;; breaks; for example, it does not handle breaks for internal
+;;; errors.

 (defun handle-breakpoint (offset component signal-context)
   (let ((data (breakpoint-data component offset nil)))
     (unless data
       (error "unknown breakpoint in ~S at offset ~S"
 (defun handle-breakpoint (offset component signal-context)
   (let ((data (breakpoint-data component offset nil)))
     (unless data
       (error "unknown breakpoint in ~S at offset ~S"

-             (debug-function-name (debug-function-from-pc component offset))
+             (debug-fun-name (debug-fun-from-pc component offset))

              offset))
     (let ((breakpoints (breakpoint-data-breakpoints data)))
       (if (or (null breakpoints)
              offset))
     (let ((breakpoints (breakpoint-data-breakpoints data)))
       (if (or (null breakpoints)

-             (eq (breakpoint-kind (car breakpoints)) :function-end))
-         (handle-function-end-breakpoint-aux breakpoints data signal-context)
+             (eq (breakpoint-kind (car breakpoints)) :fun-end))
+         (handle-fun-end-breakpoint-aux breakpoints data signal-context)

          (handle-breakpoint-aux breakpoints data
                                 offset component signal-context)))))
 
 ;;; This holds breakpoint-datas while invoking the breakpoint hooks
 ;;; associated with that particular component and location. While they
 ;;; are executing, if we hit the location again, we ignore the
          (handle-breakpoint-aux breakpoints data
                                 offset component signal-context)))))
 
 ;;; This holds breakpoint-datas while invoking the breakpoint hooks
 ;;; associated with that particular component and location. While they
 ;;; are executing, if we hit the location again, we ignore the

-;;; breakpoint to avoid infinite recursion. Function-end breakpoints
+;;; breakpoint to avoid infinite recursion. fun-end breakpoints

 ;;; must work differently since the breakpoint-data is unique for each
 ;;; invocation.
 (defvar *executing-breakpoint-hooks* nil)
 
 ;;; must work differently since the breakpoint-data is unique for each
 ;;; invocation.
 (defvar *executing-breakpoint-hooks* nil)
 

-;;; This handles code-location and debug-function :FUNCTION-START
+;;; This handles code-location and DEBUG-FUN :FUN-START

 ;;; breakpoints.
 (defun handle-breakpoint-aux (breakpoints data offset component signal-context)
   (unless breakpoints
 ;;; breakpoints.
 (defun handle-breakpoint-aux (breakpoints data offset component signal-context)
   (unless breakpoints

@@ -3563,14 +3149,16 @@
       ;; 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)

-  (let* ((debug-fun (debug-function-from-pc component offset))
+  (let* ((debug-fun (debug-fun-from-pc component offset))

         (frame (do ((f (top-frame) (frame-down f)))
         (frame (do ((f (top-frame) (frame-down f)))

-                   ((eq debug-fun (frame-debug-function f)) f))))
+                   ((eq debug-fun (frame-debug-fun f)) f))))

     (dolist (bpt breakpoints)
       (funcall (breakpoint-hook-function bpt)
               frame
     (dolist (bpt breakpoints)
       (funcall (breakpoint-hook-function bpt)
               frame

@@ -3582,21 +3170,21 @@
                   (breakpoint-unknown-return-partner bpt)
                   bpt)))))
 
                   (breakpoint-unknown-return-partner bpt)
                   bpt)))))
 

-(defun handle-function-end-breakpoint (offset component context)
+(defun handle-fun-end-breakpoint (offset component context)

   (let ((data (breakpoint-data component offset nil)))
     (unless data
       (error "unknown breakpoint in ~S at offset ~S"
   (let ((data (breakpoint-data component offset nil)))
     (unless data
       (error "unknown breakpoint in ~S at offset ~S"

-             (debug-function-name (debug-function-from-pc component offset))
+             (debug-fun-name (debug-fun-from-pc component offset))

              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))
-       (handle-function-end-breakpoint-aux breakpoints data context)))))
+       (aver (eq (breakpoint-kind (car breakpoints)) :fun-end))
+       (handle-fun-end-breakpoint-aux breakpoints data context)))))

 
 

-;;; Either HANDLE-BREAKPOINT calls this for :FUNCTION-END breakpoints
-;;; [old C code] or HANDLE-FUNCTION-END-BREAKPOINT calls this directly
+;;; Either HANDLE-BREAKPOINT calls this for :FUN-END breakpoints
+;;; [old C code] or HANDLE-FUN-END-BREAKPOINT calls this directly

 ;;; [new C code].
 ;;; [new C code].

-(defun handle-function-end-breakpoint-aux (breakpoints data signal-context)
+(defun handle-fun-end-breakpoint-aux (breakpoints data signal-context)

   (delete-breakpoint-data data)
   (let* ((scp
          (locally
   (delete-breakpoint-data data)
   (let* ((scp
          (locally

@@ -3605,24 +3193,24 @@
         (frame (do ((cfp (sb!vm:context-register scp sb!vm::cfp-offset))
                     (f (top-frame) (frame-down f)))
                    ((= cfp (sap-int (frame-pointer f))) f)
         (frame (do ((cfp (sb!vm:context-register scp sb!vm::cfp-offset))
                     (f (top-frame) (frame-down f)))
                    ((= cfp (sap-int (frame-pointer f))) f)

-                 (declare (type (unsigned-byte #.sb!vm:word-bits) cfp))))
+                 (declare (type (unsigned-byte #.sb!vm:n-word-bits) cfp))))

         (component (breakpoint-data-component data))
         (component (breakpoint-data-component data))

-        (cookie (gethash component *function-end-cookies*)))
-    (remhash component *function-end-cookies*)
+        (cookie (gethash component *fun-end-cookies*)))
+    (remhash component *fun-end-cookies*)

     (dolist (bpt breakpoints)
       (funcall (breakpoint-hook-function bpt)
               frame bpt
     (dolist (bpt breakpoints)
       (funcall (breakpoint-hook-function bpt)
               frame bpt

-              (get-function-end-breakpoint-values scp)
+              (get-fun-end-breakpoint-values scp)

               cookie))))
 
               cookie))))
 

-(defun get-function-end-breakpoint-values (scp)
+(defun get-fun-end-breakpoint-values (scp)

   (let ((ocfp (int-sap (sb!vm:context-register
                        scp
                        #!-x86 sb!vm::ocfp-offset
                        #!+x86 sb!vm::ebx-offset)))
        (nargs (make-lisp-obj
                (sb!vm:context-register scp sb!vm::nargs-offset)))
   (let ((ocfp (int-sap (sb!vm:context-register
                        scp
                        #!-x86 sb!vm::ocfp-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)

@@ -3632,30 +3220,24 @@
               (stack-ref ocfp arg-num))
             results)))
     (nreverse results)))
               (stack-ref ocfp arg-num))
             results)))
     (nreverse results)))

+\f
+;;;; MAKE-BOGUS-LRA (used for :FUN-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
   (without-gcing

-   (let* ((src-start (foreign-symbol-address "function_end_breakpoint_guts"))
-         (src-end (foreign-symbol-address "function_end_breakpoint_end"))
-         (trap-loc (foreign-symbol-address "function_end_breakpoint_trap"))
+   (let* ((src-start (foreign-symbol-address "fun_end_breakpoint_guts"))
+         (src-end (foreign-symbol-address "fun_end_breakpoint_end"))
+         (trap-loc (foreign-symbol-address "fun_end_breakpoint_trap"))

          (length (sap- src-end src-start))
          (code-object
           (%primitive
          (length (sap- src-end src-start))
          (code-object
           (%primitive

@@ -3678,13 +3260,13 @@
        (setf (code-header-ref code-object (1+ real-lra-slot)) offset))
      (setf (code-header-ref code-object known-return-p-slot)
           known-return-p)
        (setf (code-header-ref code-object (1+ real-lra-slot)) offset))
      (setf (code-header-ref code-object known-return-p-slot)
           known-return-p)

-     (system-area-copy src-start 0 dst-start 0 (* length sb!vm:byte-bits))
+     (system-area-copy src-start 0 dst-start 0 (* length sb!vm:n-byte-bits))

      (sb!vm:sanctify-for-execution code-object)
      #!+x86
      (values dst-start code-object (sap- trap-loc src-start))
      #!-x86
      (let ((new-lra (make-lisp-obj (+ (sap-int dst-start)
      (sb!vm:sanctify-for-execution code-object)
      #!+x86
      (values dst-start code-object (sap- trap-loc src-start))
      #!-x86
      (let ((new-lra (make-lisp-obj (+ (sap-int dst-start)

-                                     sb!vm:other-pointer-type))))
+                                     sb!vm:other-pointer-lowtag))))

        (set-header-data
        new-lra
        (logandc2 (+ sb!vm:code-constants-offset bogus-lra-constants 1)
        (set-header-data
        new-lra
        (logandc2 (+ sb!vm:code-constants-offset bogus-lra-constants 1)

@@ -3694,37 +3276,31 @@
 \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-FUN

 ;;; 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-FUN routines.

 
 

-(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."
+;;; 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-fun-start-location (debug-fun)

   (etypecase debug-fun
   (etypecase debug-fun

-    (compiled-debug-function
+    (compiled-debug-fun

      (code-location-from-pc debug-fun
      (code-location-from-pc debug-fun

-                           (sb!c::compiled-debug-function-start-pc
-                            (compiled-debug-function-compiler-debug-fun
+                           (sb!c::compiled-debug-fun-start-pc
+                            (compiled-debug-fun-compiler-debug-fun

                              debug-fun))
                            nil))
                              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)
 
 (defun print-code-locations (function)

-  (let ((debug-fun (function-debug-function function)))
-    (do-debug-function-blocks (block debug-fun)
+  (let ((debug-fun (fun-debug-fun function)))
+    (do-debug-fun-blocks (block debug-fun)

       (do-debug-block-locations (loc block)
        (fill-in-code-location loc)
       (do-debug-block-locations (loc block)
        (fill-in-code-location loc)

-       (format t "~S code location at ~D"
+       (format t "~S code location at ~W"

                (compiled-code-location-kind loc)
                (compiled-code-location-pc loc))
        (sb!debug::print-code-location-source-form loc 0)
                (compiled-code-location-kind loc)
                (compiled-code-location-pc loc))
        (sb!debug::print-code-location-source-form loc 0)