0.6.12.6:

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

diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index 0bead79..04e2f30 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,24 +38,26 @@
   ()
   #!+sb-doc
   (:documentation
   ()
   #!+sb-doc
   (:documentation

-   "All debug-conditions inherit from this type. These are serious conditions
+   "All DEBUG-CONDITIONs inherit from this type. These are serious conditions

     that must be handled, but they are not programmer errors."))
 
 (define-condition no-debug-info (debug-condition)
     that must be handled, but they are not programmer errors."))
 
 (define-condition no-debug-info (debug-condition)

-  ()
+  ((code-component :reader no-debug-info-code-component
+                  :initarg :code-component))

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

-  (:documentation "There is absolutely no debugging information available.")
+  (:documentation "There is no usable debugging information available.")

   (:report (lambda (condition stream)
   (:report (lambda (condition stream)

-            (declare (ignore condition))

             (fresh-line stream)
             (fresh-line stream)

-            (write-line "No debugging information available." stream))))
+            (format stream
+                    "no debug information available for ~S~%"
+                    (no-debug-info-code-component condition)))))

 
 (define-condition no-debug-function-returns (debug-condition)
   ((debug-function :reader no-debug-function-returns-debug-function
                   :initarg :debug-function))
   #!+sb-doc
   (:documentation
 
 (define-condition no-debug-function-returns (debug-condition)
   ((debug-function :reader no-debug-function-returns-debug-function
                   :initarg :debug-function))
   #!+sb-doc
   (:documentation

-   "The system could not return values from a frame with debug-function since
+   "The system could not return values from a frame with DEBUG-FUNCTION since

     it lacked information about returning values.")
   (:report (lambda (condition stream)
             (let ((fun (debug-function-function
     it lacked information about returning values.")
   (:report (lambda (condition stream)
             (let ((fun (debug-function-function

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

@@ -165,20 +164,21 @@
    (frame :reader frame-function-mismatch-frame :initarg :frame)
    (form :reader frame-function-mismatch-form :initarg :form))
   (:report (lambda (condition stream)
    (frame :reader frame-function-mismatch-frame :initarg :frame)
    (form :reader frame-function-mismatch-form :initarg :form))
   (:report (lambda (condition stream)

-            (format stream
-                    "~&Form was preprocessed for ~S,~% but called on ~S:~%  ~S"
-                    (frame-function-mismatch-code-location condition)
-                    (frame-function-mismatch-frame condition)
-                    (frame-function-mismatch-form condition)))))
-
-;;; This signals debug-conditions. If they go unhandled, then signal an
-;;; unhandled-condition error.
+            (format
+             stream
+             "~&Form was preprocessed for ~S,~% but called on ~S:~%  ~S"
+             (frame-function-mismatch-code-location condition)
+             (frame-function-mismatch-frame condition)
+             (frame-function-mismatch-form condition)))))
+
+;;; This signals debug-conditions. If they go unhandled, then signal
+;;; an UNHANDLED-DEBUG-CONDITION error.

 ;;;
 ;;; ??? Get SIGNAL in the right package!
 (defmacro debug-signal (datum &rest arguments)
   `(let ((condition (make-condition ,datum ,@arguments)))
      (signal condition)
 ;;;
 ;;; ??? Get SIGNAL in the right package!
 (defmacro debug-signal (datum &rest arguments)
   `(let ((condition (make-condition ,datum ,@arguments)))
      (signal condition)

-     (error 'unhandled-condition :condition condition)))
+     (error 'unhandled-debug-condition :condition condition)))

 \f
 ;;;; structures
 ;;;;
 \f
 ;;;; structures
 ;;;;

@@ -186,13 +186,14 @@
 ;;;; data structures created by the compiler. Whenever comments
 ;;;; preface an object or type with "compiler", they refer to the
 ;;;; internal compiler thing, not to the object or type with the same
 ;;;; data structures created by the compiler. Whenever comments
 ;;;; preface an object or type with "compiler", they refer to the
 ;;;; internal compiler thing, not to the object or type with the same

-;;;; name in the "DI" package.
+;;;; name in the "SB-DI" package.

 
 ;;;; DEBUG-VARs
 
 ;;; These exist for caching data stored in packed binary form in
 ;;; compiler debug-functions. Debug-functions store these.
 
 ;;;; DEBUG-VARs
 
 ;;; These exist for caching data stored in packed binary form in
 ;;; compiler debug-functions. Debug-functions store these.

-(defstruct (debug-var (:constructor nil))
+(defstruct (debug-var (:constructor nil)
+                     (:copier nil))

   ;; the name of the variable
   (symbol (required-argument) :type symbol)
   ;; a unique integer identification relative to other variables with the same
   ;; the name of the variable
   (symbol (required-argument) :type symbol)
   ;; a unique integer identification relative to other variables with the same

@@ -215,7 +216,8 @@
 (defstruct (compiled-debug-var
            (:include debug-var)
            (:constructor make-compiled-debug-var
 (defstruct (compiled-debug-var
            (:include debug-var)
            (:constructor make-compiled-debug-var

-                         (symbol id alive-p sc-offset save-sc-offset)))
+                         (symbol id alive-p sc-offset save-sc-offset))
+           (:copier nil))

   ;; Storage class and offset. (unexported).
   (sc-offset nil :type sb!c::sc-offset)
   ;; Storage class and offset when saved somewhere.
   ;; Storage class and offset. (unexported).
   (sc-offset nil :type sb!c::sc-offset)
   ;; Storage class and offset when saved somewhere.

@@ -223,14 +225,16 @@
 
 (defstruct (interpreted-debug-var
            (:include debug-var (alive-p t))
 
 (defstruct (interpreted-debug-var
            (:include debug-var (alive-p t))

-           (:constructor make-interpreted-debug-var (symbol ir1-var)))
+           (:constructor make-interpreted-debug-var (symbol ir1-var))
+           (:copier nil))

   ;; This is the IR1 structure that holds information about interpreted vars.
   (ir1-var nil :type sb!c::lambda-var))
 
 ;;;; frames
 
 ;;; These represent call-frames on the stack.
   ;; This is the IR1 structure that holds information about interpreted vars.
   (ir1-var nil :type sb!c::lambda-var))
 
 ;;;; frames
 
 ;;; These represent call-frames on the stack.

-(defstruct (frame (:constructor nil))
+(defstruct (frame (:constructor nil)
+                 (:copier nil))

   ;; the next frame up, or NIL when top frame
   (up nil :type (or frame null))
   ;; the previous frame down, or NIL when the bottom frame. Before
   ;; the next frame up, or NIL when top frame
   (up nil :type (or frame null))
   ;; the previous frame down, or NIL when the bottom frame. Before

@@ -272,7 +276,8 @@
            (:constructor make-compiled-frame
                          (pointer up debug-function code-location number
                                   #!+gengc saved-state-chain
            (:constructor make-compiled-frame
                          (pointer up debug-function code-location number
                                   #!+gengc saved-state-chain

-                                  &optional escaped)))
+                                  &optional escaped))
+           (:copier nil))

   ;; This indicates whether someone interrupted the frame.
   ;; (unexported). If escaped, this is a pointer to the state that was
   ;; saved when we were interrupted. On the non-gengc system, this is
   ;; 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

@@ -295,7 +300,8 @@
            (:include frame)
            (:constructor make-interpreted-frame
                          (pointer up debug-function code-location number
            (:include frame)
            (:constructor make-interpreted-frame
                          (pointer up debug-function code-location number

-                          real-frame closure)))
+                          real-frame closure))
+           (:copier nil))

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

@@ -313,7 +319,7 @@
 ;;; code-locations and other objects that reference DEBUG-FUNCTIONs
 ;;; point to unique objects. This is due to the overhead in cached
 ;;; information.
 ;;; code-locations and other objects that reference DEBUG-FUNCTIONs
 ;;; point to unique objects. This is due to the overhead in cached
 ;;; information.

-(defstruct debug-function
+(defstruct (debug-function (:copier nil))

   ;; Some representation of the function arguments. See
   ;; DEBUG-FUNCTION-LAMBDA-LIST.
   ;; NOTE: must parse vars before parsing arg list stuff.
   ;; Some representation of the function arguments. See
   ;; DEBUG-FUNCTION-LAMBDA-LIST.
   ;; NOTE: must parse vars before parsing arg list stuff.

@@ -333,7 +339,8 @@
 (defstruct (compiled-debug-function
            (:include debug-function)
            (:constructor %make-compiled-debug-function
 (defstruct (compiled-debug-function
            (:include debug-function)
            (:constructor %make-compiled-debug-function

-                         (compiler-debug-fun component)))
+                         (compiler-debug-fun component))
+           (:copier nil))

   ;; Compiler's dumped debug-function information. (unexported).
   (compiler-debug-fun nil :type sb!c::compiled-debug-function)
   ;; Code object. (unexported).
   ;; Compiler's dumped debug-function information. (unexported).
   (compiler-debug-fun nil :type sb!c::compiled-debug-function)
   ;; Code object. (unexported).

@@ -359,7 +366,8 @@
 
 (defstruct (interpreted-debug-function
            (:include debug-function)
 
 (defstruct (interpreted-debug-function
            (:include debug-function)

-           (:constructor %make-interpreted-debug-function (ir1-lambda)))
+           (:constructor %make-interpreted-debug-function (ir1-lambda))
+           (:copier nil))

   ;; This is the IR1 lambda that this debug-function represents.
   (ir1-lambda nil :type sb!c::clambda))
 
   ;; This is the IR1 lambda that this debug-function represents.
   (ir1-lambda nil :type sb!c::clambda))
 

@@ -367,7 +375,8 @@
            (:include debug-function)
            (:constructor make-bogus-debug-function
                          (%name &aux (%lambda-list nil) (%debug-vars nil)
            (:include debug-function)
            (:constructor make-bogus-debug-function
                          (%name &aux (%lambda-list nil) (%debug-vars nil)

-                                (blocks nil) (%function nil))))
+                                (blocks nil) (%function nil)))
+           (:copier nil))

   %name)
 
 (defvar *ir1-lambda-debug-function* (make-hash-table :test 'eq))
   %name)
 
 (defvar *ir1-lambda-debug-function* (make-hash-table :test 'eq))

@@ -381,8 +390,9 @@
 ;;;; 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)
   ;; This indicates whether the block is a special glob of code shared by
   ;; 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

@@ -407,14 +417,16 @@
 (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))
 
 (defstruct (interpreted-debug-block (:include debug-block
                                              (elsewhere-p nil))
                                    (:constructor %make-interpreted-debug-block
   (code-locations nil :type simple-vector))
 
 (defstruct (interpreted-debug-block (:include debug-block
                                              (elsewhere-p nil))
                                    (:constructor %make-interpreted-debug-block

-                                                 (ir1-block)))
+                                                 (ir1-block))
+                                   (:copier nil))

   ;; This is the IR1 block this debug-block represents.
   (ir1-block nil :type sb!c::cblock)
   ;; Code-location information for the block.
   ;; This is the IR1 block this debug-block represents.
   (ir1-block nil :type sb!c::cblock)
   ;; Code-location information for the block.

@@ -433,7 +445,7 @@
 ;;; 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)
 ;;; 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)
+  (declare (type sb!c::cblock ir1-block))

   (let ((res (gethash ir1-block *ir1-block-debug-block*)))
     (or res
        (let ((lambda (sb!c::block-home-lambda ir1-block)))
   (let ((res (gethash ir1-block *ir1-block-debug-block*)))
     (or res
        (let ((lambda (sb!c::block-home-lambda ir1-block)))

@@ -465,7 +477,8 @@
 ;;; This is an internal structure that manages information about a
 ;;; breakpoint locations. See *COMPONENT-BREAKPOINT-OFFSETS*.
 (defstruct (breakpoint-data (:constructor make-breakpoint-data
 ;;; 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.

@@ -483,7 +496,8 @@
            (breakpoint-data-offset obj))))
 
 (defstruct (breakpoint (:constructor %make-breakpoint
            (breakpoint-data-offset obj))))
 
 (defstruct (breakpoint (:constructor %make-breakpoint

-                                    (hook-function what kind %info)))
+                                    (hook-function what kind %info))
+                      (:copier nil))

   ;; This is the function invoked when execution encounters the
   ;; breakpoint. It takes a frame, the breakpoint, and optionally a
   ;; list of values. Values are supplied for :FUNCTION-END breakpoints
   ;; This is the function invoked when execution encounters the
   ;; breakpoint. It takes a frame, the breakpoint, and optionally a
   ;; list of values. Values are supplied for :FUNCTION-END breakpoints

@@ -550,7 +564,8 @@
 
 ;;;; CODE-LOCATIONs
 
 
 ;;;; CODE-LOCATIONs
 

-(defstruct (code-location (:constructor nil))
+(defstruct (code-location (:constructor nil)
+                         (:copier nil))

   ;; This is the debug-function containing code-location.
   (debug-function nil :type debug-function)
   ;; This is initially :UNSURE. Upon first trying to access an
   ;; This is the debug-function containing code-location.
   (debug-function nil :type debug-function)
   ;; This is initially :UNSURE. Upon first trying to access an

@@ -586,7 +601,8 @@
            (:constructor make-known-code-location
                          (pc debug-function %tlf-offset %form-number
                              %live-set kind &aux (%unknown-p nil)))
            (:constructor make-known-code-location
                          (pc debug-function %tlf-offset %form-number
                              %live-set kind &aux (%unknown-p nil)))

-           (:constructor make-compiled-code-location (pc debug-function)))
+           (:constructor make-compiled-code-location (pc debug-function))
+           (:copier nil))

   ;; This is an index into debug-function's component slot.
   (pc nil :type sb!c::index)
   ;; This is a bit-vector indexed by a variable's position in
   ;; This is an index into debug-function's component slot.
   (pc nil :type sb!c::index)
   ;; This is a bit-vector indexed by a variable's position in

@@ -601,7 +617,8 @@
            (:include code-location
                      (%unknown-p nil))
            (:constructor make-interpreted-code-location
            (:include code-location
                      (%unknown-p nil))
            (:constructor make-interpreted-code-location

-                         (ir1-node debug-function)))
+                         (ir1-node debug-function))
+           (:copier nil))

   ;; This is an index into debug-function's component slot.
   (ir1-node nil :type sb!c::node))
 
   ;; This is an index into debug-function's component slot.
   (ir1-node nil :type sb!c::node))
 

@@ -674,18 +691,15 @@
 #!-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)))
+       (sap<= #!-gengc (int-sap control-stack-start)

              #!+gengc (mutator-control-stack-base)
              x)
        (zerop (logand (sap-int x) #b11)))
              #!+gengc (mutator-control-stack-base)
              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))))
 
 #!+(or gengc x86)
        (zerop (logand (sap-int x) #b11))))
 
 #!+(or gengc x86)

@@ -729,9 +743,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 +752,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)

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

@@ -1060,7 +1077,7 @@
                                  code (1+ real-lra-slot)))
                 (setq code (code-header-ref code real-lra-slot))
 ;               (format t "ccf3 :bogus-lra ~S ~S~%" code pc-offset)
                                  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)))
+                (aver code)))

              (t
               ;; Not escaped
               (multiple-value-setq (pc-offset code)
              (t
               ;; Not escaped
               (multiple-value-setq (pc-offset code)

@@ -1089,20 +1106,6 @@
                               (if up-frame (1+ (frame-number up-frame)) 0)
                               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"))

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

@@ -1116,9 +1119,8 @@
          (without-gcing
           (let* ((component-ptr (component-ptr-from-pc
                                  (sb!vm:context-pc context)))
          (without-gcing
           (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))))

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

@@ -1131,13 +1133,59 @@
               (unless (<= 0 pc-offset
                           (* (code-header-ref code sb!vm:code-code-size-slot)
                              sb!vm:word-bytes))
               (unless (<= 0 pc-offset
                           (* (code-header-ref code sb!vm:code-code-size-slot)
                              sb!vm:word-bytes))

-                ;; We were in an assembly routine. Therefore, use the LRA as
-                ;; the pc.
+                ;; We were in an assembly routine. Therefore, use the
+                ;; LRA as the pc.
+                ;;
+                ;; FIXME: Should this be WARN or ERROR or what?

                 (format t "** pc-offset ~S not in code obj ~S?~%"
                         pc-offset code))
               (return
                (values code pc-offset context))))))))))
 
                 (format t "** pc-offset ~S not in code obj ~S?~%"
                         pc-offset code))
               (return
                (values code pc-offset context))))))))))
 

+#!-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))
+    (sb!alien:with-alien
+     ((lisp-interrupt-contexts (array (* os-context-t) nil) :extern))
+     (let ((scp (sb!alien:deref lisp-interrupt-contexts index)))
+       (when (= (sap-int frame-pointer)
+                (sb!vm:context-register scp sb!vm::cfp-offset))
+         (without-gcing
+          (let ((code (code-object-from-bits
+                       (sb!vm:context-register scp sb!vm::code-offset))))
+            (when (symbolp code)
+              (return (values code 0 scp)))
+            (let* ((code-header-len (* (get-header-data code)
+                                       sb!vm:word-bytes))
+                   (pc-offset
+                    (- (sap-int (sb!vm:context-pc scp))
+                       (- (get-lisp-obj-address code)
+                          sb!vm:other-pointer-type)
+                       code-header-len)))
+              ;; Check to see whether we were executing in a branch
+              ;; delay slot.
+              #!+(or pmax sgi) ; pmax only (and broken anyway)
+              (when (logbitp 31 (sb!alien:slot scp '%mips::sc-cause))
+                (incf pc-offset sb!vm:word-bytes))
+              (unless (<= 0 pc-offset
+                          (* (code-header-ref code sb!vm:code-code-size-slot)
+                             sb!vm:word-bytes))
+                ;; We were in an assembly routine. Therefore, use the
+                ;; LRA as the pc.
+                (setf pc-offset
+                      (- (sb!vm:context-register scp sb!vm::lra-offset)
+                         (get-lisp-obj-address code)
+                         code-header-len)))
+               (return
+                (if (eq (%code-debug-info code) :bogus-lra)
+                    (let ((real-lra (code-header-ref code
+                                                     real-lra-slot)))
+                      (values (lra-code-header real-lra)
+                              (get-header-data real-lra)
+                              nil))
+                  (values code pc-offset scp)))))))))))
+

 ;;; Find the code object corresponding to the object represented by
 ;;; bits and return it. We assume bogus functions correspond to the
 ;;; undefined-function.
 ;;; Find the code object corresponding to the object represented by
 ;;; bits and return it. We assume bogus functions correspond to the
 ;;; undefined-function.

@@ -1195,7 +1243,7 @@
   (let ((info (%code-debug-info component)))
     (cond
      ((not info)
   (let ((info (%code-debug-info component)))
     (cond
      ((not info)

-      (debug-signal 'no-debug-info))
+      (debug-signal 'no-debug-info :code-component component))

      ((eq info :bogus-lra)
       (make-bogus-debug-function "function end breakpoint"))
      (t
      ((eq info :bogus-lra)
       (make-bogus-debug-function "function end breakpoint"))
      (t

@@ -1208,8 +1256,7 @@
                  (elsewhere-p
                   (>= pc (sb!c::compiled-debug-function-elsewhere-pc
                           (svref function-map 0)))))
                  (elsewhere-p
                   (>= pc (sb!c::compiled-debug-function-elsewhere-pc
                           (svref function-map 0)))))

-             ;; FIXME: I don't think SB!C is the home package of INDEX.
-             (declare (type sb!c::index i))
+             (declare (type sb!int:index i))

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

@@ -1581,7 +1628,7 @@
                                (push (frob final-arg debug-vars) res))
                               (:keyword
                                (push (list :keyword
                                (push (frob final-arg debug-vars) res))
                               (:keyword
                                (push (list :keyword

-                                           (sb!c::arg-info-keyword info)
+                                           (sb!c::arg-info-key info)

                                            (frob final-arg debug-vars))
                                      res))
                               (:rest
                                            (frob final-arg debug-vars))
                                      res))
                               (:rest

@@ -1682,11 +1729,11 @@
                       res))
                (sb!c::more-arg
                 ;; Just ignore the fact that the next two args are
                       res))
                (sb!c::more-arg
                 ;; Just ignore the fact that the next two args are

-                ;; the more arg context and count, and act like they
+                ;; the &MORE arg context and count, and act like they

                 ;; are regular arguments.
                 nil)
                (t
                 ;; are regular arguments.
                 nil)
                (t

-                ;; keyword arg
+                ;; &KEY arg

                 (push (list :keyword
                             ele
                             (compiled-debug-function-lambda-list-var
                 (push (list :keyword
                             ele
                             (compiled-debug-function-lambda-list-var

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

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

@@ -2007,7 +2054,7 @@
       (if (logtest flags sb!c::minimal-debug-function-setf-bit)
          `(setf ,base)
          base))
       (if (logtest flags sb!c::minimal-debug-function-setf-bit)
          `(setf ,base)
          base))

-    :kind (svref sb!c::minimal-debug-function-kinds
+    :kind (svref sb!c::*minimal-debug-function-kinds*

                 (ldb sb!c::minimal-debug-function-kind-byte options))
     :variables
     (when vars-p
                 (ldb sb!c::minimal-debug-function-kind-byte options))
     :variables
     (when vars-p

@@ -2071,14 +2118,14 @@
 
       (coerce (cdr (res)) 'simple-vector))))
 
 
       (coerce (cdr (res)) 'simple-vector))))
 

-;;; This variable maps minimal debug-info function maps to an unpacked
-;;; version thereof.
+;;; a map from minimal DEBUG-INFO function maps to unpacked
+;;; versions thereof

 (defvar *uncompacted-function-maps* (make-hash-table :test 'eq))
 
 (defvar *uncompacted-function-maps* (make-hash-table :test 'eq))
 

-;;; Return a function-map for a given compiled-debug-info object. If
+;;; Return a FUNCTION-MAP for a given COMPILED-DEBUG-info object. If

 ;;; the info is minimal, and has not been parsed, then parse it.
 ;;;
 ;;; the info is minimal, and has not been parsed, then parse it.
 ;;;

-;;; FIXME: Now that we no longer use the minimal-debug-function
+;;; FIXME: Now that we no longer use the MINIMAL-DEBUG-FUNCTION

 ;;; representation, calls to this function can be replaced by calls to
 ;;; the bare COMPILED-DEBUG-INFO-FUNCTION-MAP slot accessor function,
 ;;; and this function and everything it calls become dead code which
 ;;; representation, calls to this function can be replaced by calls to
 ;;; the bare COMPILED-DEBUG-INFO-FUNCTION-MAP slot accessor function,
 ;;; and this function and everything it calls become dead code which

@@ -2094,17 +2141,14 @@
 \f
 ;;;; CODE-LOCATIONs
 
 \f
 ;;;; CODE-LOCATIONs
 

-;;; If we're sure of whether code-location is known, return t or nil.
-;;; If we're :unsure, then try to fill in the code-location's slots.
+;;; If we're sure of whether code-location is known, return T or NIL.
+;;; If we're :UNSURE, then try to fill in the code-location's slots.

 ;;; This determines whether there is any debug-block information, and
 ;;; if code-location is known.
 ;;;
 ;;; ??? IF this conses closures every time it's called, then break off the
 ;;; This determines whether there is any debug-block information, and
 ;;; if code-location is known.
 ;;;
 ;;; ??? IF this conses closures every time it's called, then break off the

-;;; :unsure part to get the HANDLER-CASE into another function.
+;;; :UNSURE part to get the HANDLER-CASE into another function.

 (defun code-location-unknown-p (basic-code-location)
 (defun code-location-unknown-p (basic-code-location)

-  #!+sb-doc
-  "Returns whether basic-code-location is unknown. It returns nil when the
-   code-location is known."

   (ecase (code-location-%unknown-p basic-code-location)
     ((t) t)
     ((nil) nil)
   (ecase (code-location-%unknown-p basic-code-location)
     ((t) t)
     ((nil) nil)

@@ -2113,11 +2157,10 @@
           (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
   (let ((block (code-location-%debug-block basic-code-location)))
     (if (eq block :unparsed)
        (etypecase basic-code-location

@@ -2130,10 +2173,10 @@
                   (interpreted-code-location-ir1-node basic-code-location))))))
        block)))
 
                   (interpreted-code-location-ir1-node basic-code-location))))))
        block)))
 

-;;; This stores and returns BASIC-CODE-LOCATION's debug-block. It
-;;; determines the correct one using the code-location's pc. This uses
+;;; Store and return BASIC-CODE-LOCATION's debug-block. We determines
+;;; the correct one using the code-location's pc. We use

 ;;; DEBUG-FUNCTION-DEBUG-BLOCKS to return the cached block information
 ;;; DEBUG-FUNCTION-DEBUG-BLOCKS to return the cached block information

-;;; or signal a 'no-debug-blocks condition. The blocks are sorted by
+;;; or signal a NO-DEBUG-BLOCKS condition. The blocks are sorted by

 ;;; their first code-location's pc, in ascending order. Therefore, as
 ;;; soon as we find a block that starts with a pc greater than
 ;;; basic-code-location's pc, we know the previous block contains the
 ;;; their first code-location's pc, in ascending order. Therefore, as
 ;;; soon as we find a block that starts with a pc greater than
 ;;; basic-code-location's pc, we know the previous block contains the

@@ -2284,8 +2327,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,9 +2336,8 @@
               (compiled-code-location-%live-set code-location))
              (t live-set)))))
 
               (compiled-code-location-%live-set code-location))
              (t live-set)))))
 

+;;; true if OBJ1 and OBJ2 are the same place in the code

 (defun code-location= (obj1 obj2)
 (defun code-location= (obj1 obj2)

-  #!+sb-doc
-  "Returns whether obj1 and obj2 are the same place in the code."

   (etypecase obj1
     (compiled-code-location
      (etypecase obj2
   (etypecase obj1
     (compiled-code-location
      (etypecase obj2

@@ -2316,7 +2358,7 @@
   (= (compiled-code-location-pc obj1)
      (compiled-code-location-pc obj2)))
 
   (= (compiled-code-location-pc obj1)
      (compiled-code-location-pc obj2)))
 

-;;; This fills in CODE-LOCATION's :unparsed slots. It returns t or nil
+;;; Fill in CODE-LOCATION's :UNPARSED slots, returning T or NIL

 ;;; depending on whether the code-location was known in its
 ;;; debug-function's debug-block information. This may signal a
 ;;; NO-DEBUG-BLOCKS condition due to DEBUG-FUNCTION-DEBUG-BLOCKS, and
 ;;; depending on whether the code-location was known in its
 ;;; debug-function's debug-block information. This may signal a
 ;;; NO-DEBUG-BLOCKS condition due to DEBUG-FUNCTION-DEBUG-BLOCKS, and

@@ -2424,13 +2466,13 @@
    invalid. This is SETF'able."
   (etypecase debug-var
     (compiled-debug-var
    invalid. This is SETF'able."
   (etypecase debug-var
     (compiled-debug-var

-     (check-type frame compiled-frame)
+     (aver (typep 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
      (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)
+     (aver (typep 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)
      (sb!eval::leaf-value-lambda-var
       (interpreted-code-location-ir1-node (frame-code-location frame))
       (interpreted-debug-var-ir1-var debug-var)

@@ -2441,16 +2483,17 @@
 ;;; 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)
 ;;; 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.

@@ -2460,7 +2503,7 @@
 ;;; those variables are invalid.)
 (defun make-valid-lisp-obj (val)
   (/show0 "entering MAKE-VALID-LISP-OBJ, VAL=..")
 ;;; those variables are invalid.)
 (defun make-valid-lisp-obj (val)
   (/show0 "entering MAKE-VALID-LISP-OBJ, VAL=..")

-  #!+sb-show (%primitive print (sb!impl::hexstr val))
+  #!+sb-show (/hexstr val)

   (if (or
        ;; fixnum
        (zerop (logand val 3))
   (if (or
        ;; fixnum
        (zerop (logand val 3))

@@ -2480,32 +2523,166 @@
                (< sb!vm:static-space-start val
                   (* sb!vm:*static-space-free-pointer*
                      sb!vm:word-bytes))
                (< sb!vm:static-space-start val
                   (* sb!vm:*static-space-free-pointer*
                      sb!vm:word-bytes))

-               (< (sb!vm:dynamic-space-start) val
+               (< 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 (* sb!vm::nfp-save-offset
+                                                          sb!vm:word-bytes))
+                                #!+alpha
+                                (sb!vm::make-number-stack-pointer
+                                 (sb!sys:sap-ref-32 fp (* sb!vm::nfp-save-offset
+                                                          sb!vm:word-bytes))))))
+                  ,@body)))
+    (ecase (sb!c:sc-offset-scn sc-offset)
+      ((#.sb!vm:any-reg-sc-number
+        #.sb!vm:descriptor-reg-sc-number
+        #!+rt #.sb!vm:word-pointer-reg-sc-number)
+       (sb!sys:without-gcing
+        (with-escaped-value (val) (sb!kernel:make-lisp-obj val))))
+                            
+      (#.sb!vm:base-char-reg-sc-number
+       (with-escaped-value (val)
+         (code-char val)))
+      (#.sb!vm:sap-reg-sc-number
+       (with-escaped-value (val)
+         (sb!sys:int-sap val)))
+      (#.sb!vm:signed-reg-sc-number
+       (with-escaped-value (val)
+         (if (logbitp (1- sb!vm:word-bits) val)
+             (logior val (ash -1 sb!vm:word-bits))
+             val)))
+      (#.sb!vm:unsigned-reg-sc-number
+       (with-escaped-value (val)
+         val))
+      (#.sb!vm:non-descriptor-reg-sc-number
+       (error "Local non-descriptor register access?"))
+      (#.sb!vm:interior-reg-sc-number
+       (error "Local interior register access?"))
+      (#.sb!vm:single-reg-sc-number
+       (escaped-float-value single-float))
+      (#.sb!vm:double-reg-sc-number
+       (escaped-float-value double-float))
+      #!+long-float
+      (#.sb!vm:long-reg-sc-number
+       (escaped-float-value long-float))
+      (#.sb!vm:complex-single-reg-sc-number
+       (if escaped
+           (complex
+            (sb!vm:context-float-register
+             escaped (sb!c:sc-offset-offset sc-offset) 'single-float)
+            (sb!vm:context-float-register
+             escaped (1+ (sb!c:sc-offset-offset sc-offset)) 'single-float))
+           :invalid-value-for-unescaped-register-storage))
+      (#.sb!vm:complex-double-reg-sc-number
+       (if escaped
+           (complex
+            (sb!vm:context-float-register
+             escaped (sb!c:sc-offset-offset sc-offset) 'double-float)
+            (sb!vm:context-float-register
+             escaped (+ (sb!c:sc-offset-offset sc-offset) #!+sparc 2 #-sparc 1)
+             'double-float))
+           :invalid-value-for-unescaped-register-storage))
+      #!+long-float
+      (#.sb!vm:complex-long-reg-sc-number
+       (if escaped
+           (complex
+            (sb!vm:context-float-register
+             escaped (sb!c:sc-offset-offset sc-offset) 'long-float)
+            (sb!vm:context-float-register
+             escaped (+ (sb!c:sc-offset-offset sc-offset) #!+sparc 4)
+             'long-float))
+           :invalid-value-for-unescaped-register-storage))
+      (#.sb!vm:single-stack-sc-number
+       (with-nfp (nfp)
+         (sb!sys:sap-ref-single nfp (* (sb!c:sc-offset-offset sc-offset)
+                                       sb!vm:word-bytes))))
+      (#.sb!vm:double-stack-sc-number
+       (with-nfp (nfp)
+         (sb!sys:sap-ref-double nfp (* (sb!c:sc-offset-offset sc-offset)
+                                       sb!vm:word-bytes))))
+      #!+long-float
+      (#.sb!vm:long-stack-sc-number
+       (with-nfp (nfp)
+         (sb!sys:sap-ref-long nfp (* (sb!c:sc-offset-offset sc-offset)
+                                     sb!vm:word-bytes))))
+      (#.sb!vm:complex-single-stack-sc-number
+       (with-nfp (nfp)
+         (complex
+          (sb!sys:sap-ref-single nfp (* (sb!c:sc-offset-offset sc-offset)
+                                        sb!vm:word-bytes))
+          (sb!sys:sap-ref-single nfp (* (1+ (sb!c:sc-offset-offset sc-offset))
+                                        sb!vm:word-bytes)))))
+      (#.sb!vm:complex-double-stack-sc-number
+       (with-nfp (nfp)
+         (complex
+          (sb!sys:sap-ref-double nfp (* (sb!c:sc-offset-offset sc-offset)
+                                        sb!vm:word-bytes))
+          (sb!sys:sap-ref-double nfp (* (+ (sb!c:sc-offset-offset sc-offset) 2)
+                                        sb!vm:word-bytes)))))
+      #!+long-float
+      (#.sb!vm:complex-long-stack-sc-number
+       (with-nfp (nfp)
+         (complex
+          (sb!sys:sap-ref-long nfp (* (sb!c:sc-offset-offset sc-offset)
+                                      sb!vm:word-bytes))
+          (sb!sys:sap-ref-long nfp (* (+ (sb!c:sc-offset-offset sc-offset)
+                                         #!+sparc 4)
+                                      sb!vm:word-bytes)))))
+      (#.sb!vm:control-stack-sc-number
+       (sb!kernel:stack-ref fp (sb!c:sc-offset-offset sc-offset)))
+      (#.sb!vm:base-char-stack-sc-number
+       (with-nfp (nfp)
+         (code-char (sb!sys:sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset)
+                                              sb!vm:word-bytes)))))
+      (#.sb!vm:unsigned-stack-sc-number
+       (with-nfp (nfp)
+         (sb!sys:sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset)
+                                   sb!vm:word-bytes))))
+      (#.sb!vm:signed-stack-sc-number
+       (with-nfp (nfp)
+         (sb!sys:signed-sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset)
+                                          sb!vm:word-bytes))))
+      (#.sb!vm:sap-stack-sc-number
+       (with-nfp (nfp)
+         (sb!sys:sap-ref-sap nfp (* (sb!c:sc-offset-offset sc-offset)
+                                    sb!vm:word-bytes)))))))

 
 #!+x86
 (defun sub-access-debug-var-slot (fp sc-offset &optional escaped)
   (declare (type system-area-pointer fp))
   (/show0 "entering SUB-ACCESS-DEBUG-VAR-SLOT, FP,SC-OFFSET,ESCAPED=..")
 
 #!+x86
 (defun sub-access-debug-var-slot (fp sc-offset &optional escaped)
   (declare (type system-area-pointer fp))
   (/show0 "entering SUB-ACCESS-DEBUG-VAR-SLOT, FP,SC-OFFSET,ESCAPED=..")

-  #!+sb-show (%primitive print (sb!impl::hexstr fp))
-  #!+sb-show (%primitive print (sb!impl::hexstr sc-offset))
-  #!+sb-show (%primitive print (sb!impl::hexstr escaped))
+  (/hexstr fp) (/hexstr sc-offset) (/hexstr escaped)

   (macrolet ((with-escaped-value ((var) &body forms)
               `(if escaped
                    (let ((,var (sb!vm:context-register
                                 escaped
                                 (sb!c:sc-offset-offset sc-offset))))
                      (/show0 "in escaped case, ,VAR value=..")
   (macrolet ((with-escaped-value ((var) &body forms)
               `(if escaped
                    (let ((,var (sb!vm:context-register
                                 escaped
                                 (sb!c:sc-offset-offset sc-offset))))
                      (/show0 "in escaped case, ,VAR value=..")

-                     #!+sb-show (%primitive print (sb!impl::hexstr ,var))
+                     (/hexstr ,var)

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

@@ -2527,7 +2704,7 @@
        (without-gcing
        (with-escaped-value (val)
          (/show0 "VAL=..")
        (without-gcing
        (with-escaped-value (val)
          (/show0 "VAL=..")

-         #!+sb-show (%primitive print (sb!impl::hexstr val))
+         (/hexstr val)

          (make-valid-lisp-obj val))))
       (#.sb!vm:base-char-reg-sc-number
        (/show0 "case of BASE-CHAR-REG-SC-NUMBER")
          (make-valid-lisp-obj val))))
       (#.sb!vm:base-char-reg-sc-number
        (/show0 "case of BASE-CHAR-REG-SC-NUMBER")

@@ -2632,13 +2809,13 @@
 (defun %set-debug-var-value (debug-var frame value)
   (etypecase debug-var
     (compiled-debug-var
 (defun %set-debug-var-value (debug-var frame value)
   (etypecase debug-var
     (compiled-debug-var

-     (check-type frame compiled-frame)
+     (aver (typep 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
      (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)
+     (aver (typep 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)
      (sb!eval::set-leaf-value-lambda-var
       (interpreted-code-location-ir1-node (frame-code-location frame))
       (interpreted-debug-var-ir1-var debug-var)

@@ -2687,13 +2864,13 @@
                                                         sb!vm::nfp-offset))
                                #!-alpha
                                (sap-ref-sap fp
                                                         sb!vm::nfp-offset))
                                #!-alpha
                                (sap-ref-sap fp

-                                                   (* sb!vm::nfp-save-offset
-                                                      sb!vm:word-bytes))
+                                            (* sb!vm::nfp-save-offset
+                                               sb!vm:word-bytes))

                                #!+alpha
                                #!+alpha

-                               (%alpha::make-number-stack-pointer
+                               (sb!vm::make-number-stack-pointer

                                 (sap-ref-32 fp
                                 (sap-ref-32 fp

-                                                   (* sb!vm::nfp-save-offset
-                                                      sb!vm:word-bytes))))))
+                                            (* sb!vm::nfp-save-offset
+                                               sb!vm:word-bytes))))))

                  ,@body)))
     (ecase (sb!c:sc-offset-scn sc-offset)
       ((#.sb!vm:any-reg-sc-number
                  ,@body)))
     (ecase (sb!c:sc-offset-scn sc-offset)
       ((#.sb!vm:any-reg-sc-number

@@ -2939,7 +3116,7 @@
     (compiled-debug-var
      (compiled-debug-var-validity debug-var basic-code-location))
     (interpreted-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)
+     (aver (typep basic-code-location 'interpreted-code-location))

      (let ((validp (rassoc (interpreted-debug-var-ir1-var debug-var)
                           (sb!c::lexenv-variables
                            (sb!c::node-lexenv
      (let ((validp (rassoc (interpreted-debug-var-ir1-var debug-var)
                           (sb!c::lexenv-variables
                            (sb!c::node-lexenv

@@ -2950,7 +3127,7 @@
 ;;; This is the method for DEBUG-VAR-VALIDITY for COMPILED-DEBUG-VARs.
 ;;; For safety, make sure basic-code-location is what we think.
 (defun compiled-debug-var-validity (debug-var basic-code-location)
 ;;; This is the method for DEBUG-VAR-VALIDITY for COMPILED-DEBUG-VARs.
 ;;; For safety, make sure basic-code-location is what we think.
 (defun compiled-debug-var-validity (debug-var basic-code-location)

-  (check-type basic-code-location compiled-code-location)
+  (declare (type compiled-code-location basic-code-location))

   (cond ((debug-var-alive-p debug-var)
         (let ((debug-fun (code-location-debug-function basic-code-location)))
           (if (>= (compiled-code-location-pc basic-code-location)
   (cond ((debug-var-alive-p debug-var)
         (let ((debug-fun (code-location-debug-function basic-code-location)))
           (if (>= (compiled-code-location-pc basic-code-location)

@@ -2962,14 +3139,16 @@
        (t
         (let ((pos (position debug-var
                              (debug-function-debug-vars
        (t
         (let ((pos (position debug-var
                              (debug-function-debug-vars

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

           (unless pos
             (error 'unknown-debug-var
                    :debug-var debug-var
                    :debug-function
                    (code-location-debug-function basic-code-location)))
           ;; There must be live-set info since basic-code-location is known.
           (unless pos
             (error 'unknown-debug-var
                    :debug-var debug-var
                    :debug-function
                    (code-location-debug-function basic-code-location)))
           ;; There must be live-set info since basic-code-location is known.

-          (if (zerop (sbit (compiled-code-location-live-set basic-code-location)
+          (if (zerop (sbit (compiled-code-location-live-set
+                            basic-code-location)

                            pos))
               :invalid
               :valid)))))
                            pos))
               :invalid
               :valid)))))

@@ -2993,21 +3172,21 @@
 ;;; Given the DEFUN, 3 gets you the LET, 1 gets you the bindings, 0
 ;;; gets the first binding, and 1 gets the AREF form.
 
 ;;; Given the DEFUN, 3 gets you the LET, 1 gets you the bindings, 0
 ;;; gets the first binding, and 1 gets the AREF form.
 

-;;; Temporary buffer used to build form-number => source-path translation in
-;;; FORM-NUMBER-TRANSLATIONS.
+;;; temporary buffer used to build form-number => source-path translation in
+;;; FORM-NUMBER-TRANSLATIONS

 (defvar *form-number-temp* (make-array 10 :fill-pointer 0 :adjustable t))
 
 (defvar *form-number-temp* (make-array 10 :fill-pointer 0 :adjustable t))
 

-;;; Table used to detect CAR circularities in FORM-NUMBER-TRANSLATIONS.
+;;; table used to detect CAR circularities in FORM-NUMBER-TRANSLATIONS

 (defvar *form-number-circularity-table* (make-hash-table :test 'eq))
 
 (defvar *form-number-circularity-table* (make-hash-table :test 'eq))
 

+;;; This returns a table mapping form numbers to source-paths. A source-path
+;;; indicates a descent into the top-level-form form, going directly to the
+;;; subform corressponding to the form number.
+;;;

 ;;; The vector elements are in the same format as the compiler's
 ;;; The vector elements are in the same format as the compiler's

-;;; NODE-SOUCE-PATH; that is, the first element is the form number and the last
-;;; is the top-level-form number.
+;;; NODE-SOURCE-PATH; that is, the first element is the form number and
+;;; the last is the top-level-form number.

 (defun form-number-translations (form tlf-number)
 (defun form-number-translations (form tlf-number)

-  #!+sb-doc
-  "This returns a table mapping form numbers to source-paths. A source-path
-   indicates a descent into the top-level-form form, going directly to the
-   subform corressponding to the form number."

   (clrhash *form-number-circularity-table*)
   (setf (fill-pointer *form-number-temp*) 0)
   (sub-translate-form-numbers form (list tlf-number))
   (clrhash *form-number-circularity-table*)
   (setf (fill-pointer *form-number-temp*) 0)
   (sub-translate-form-numbers form (list tlf-number))

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

@@ -3073,17 +3252,15 @@
 \f
 ;;;; PREPROCESS-FOR-EVAL and EVAL-IN-FRAME
 
 \f
 ;;;; PREPROCESS-FOR-EVAL and EVAL-IN-FRAME
 

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

 (defun preprocess-for-eval (form loc)
 (defun preprocess-for-eval (form loc)

-  #!+sb-doc
-  "Return a function of one argument that evaluates form in the lexical
-   context of the basic-code-location loc. PREPROCESS-FOR-EVAL signals a
-   no-debug-vars condition when the loc's debug-function has no
-   debug-var information available. The returned function takes the frame
-   to get values from as its argument, and it returns the values of form.
-   The returned function signals the following conditions: invalid-value,
-   ambiguous-variable-name, and frame-function-mismatch"

   (declare (type code-location loc))
   (let ((n-frame (gensym))
        (fun (code-location-debug-function loc)))
   (declare (type code-location loc))
   (let ((n-frame (gensym))
        (fun (code-location-debug-function loc)))

@@ -3125,49 +3302,53 @@
                            :code-location loc :form form :frame frame))
            (funcall res frame))))))
 
                            :code-location loc :form form :frame frame))
            (funcall res frame))))))
 

+;;; Evaluate FORM in the lexical context of FRAME's current code
+;;; location, returning the results of the evaluation.

 (defun eval-in-frame (frame form)
   (declare (type frame 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
 
   (funcall (preprocess-for-eval form (frame-code-location frame)) frame))
 \f
 ;;;; breakpoints
 
 ;;;; user-visible interface
 

+;;; Create and return a breakpoint. When program execution encounters
+;;; the breakpoint, the system calls HOOK-FUNCTION. HOOK-FUNCTION takes the
+;;; current frame for the function in which the program is running and the
+;;; breakpoint object.
+;;;
+;;; WHAT and KIND determine where in a function the system invokes
+;;; HOOK-FUNCTION. WHAT is either a code-location or a debug-function.
+;;; KIND is one of :CODE-LOCATION, :FUNCTION-START, or :FUNCTION-END.
+;;; Since the starts and ends of functions may not have code-locations
+;;; representing them, designate these places by supplying WHAT as a
+;;; debug-function and KIND indicating the :FUNCTION-START or
+;;; :FUNCTION-END. When WHAT is a debug-function and kind is
+;;; :FUNCTION-END, then hook-function must take two additional
+;;; arguments, a list of values returned by the function and a
+;;; FUNCTION-END-COOKIE.
+;;;
+;;; INFO is information supplied by and used by the user.
+;;;
+;;; FUNCTION-END-COOKIE is a function. To implement :FUNCTION-END
+;;; breakpoints, the system uses starter breakpoints to establish the
+;;; :FUNCTION-END breakpoint for each invocation of the function. Upon
+;;; each entry, the system creates a unique cookie to identify the
+;;; invocation, and when the user supplies a function for this
+;;; argument, the system invokes it on the frame and the cookie. The
+;;; system later invokes the :FUNCTION-END breakpoint hook on the same
+;;; cookie. The user may save the cookie for comparison in the hook
+;;; function.
+;;;
+;;; Signal an error if WHAT is an unknown code-location.

 (defun make-breakpoint (hook-function what
                        &key (kind :code-location) info function-end-cookie)
 (defun make-breakpoint (hook-function what
                        &key (kind :code-location) info function-end-cookie)

-  #!+sb-doc
-  "This creates and returns a breakpoint. When program execution encounters
-   the breakpoint, the system calls hook-function. Hook-function takes the
-   current frame for the function in which the program is running and the
-   breakpoint object.
-      What and kind determine where in a function the system invokes
-   hook-function. What is either a code-location or a debug-function. Kind is
-   one of :code-location, :function-start, or :function-end. Since the starts
-   and ends of functions may not have code-locations representing them,
-   designate these places by supplying what as a debug-function and kind
-   indicating the :function-start or :function-end. When what is a
-   debug-function and kind is :function-end, then hook-function must take two
-   additional arguments, a list of values returned by the function and a
-   function-end-cookie.
-      Info is information supplied by and used by the user.
-      Function-end-cookie is a function. To implement :function-end breakpoints,
-   the system uses starter breakpoints to establish the :function-end breakpoint
-   for each invocation of the function. Upon each entry, the system creates a
-   unique cookie to identify the invocation, and when the user supplies a
-   function for this argument, the system invokes it on the frame and the
-   cookie. The system later invokes the :function-end breakpoint hook on the
-   same cookie. The user may save the cookie for comparison in the hook
-   function.
-      This signals an error if what is an unknown code-location."

   (etypecase what
     (code-location
      (when (code-location-unknown-p what)
        (error "cannot make a breakpoint at an unknown code location: ~S"
              what))
   (etypecase what
     (code-location
      (when (code-location-unknown-p what)
        (error "cannot make a breakpoint at an unknown code location: ~S"
              what))

-     (assert (eq kind :code-location))
+     (aver (eq kind :code-location))

      (let ((bpt (%make-breakpoint hook-function what kind info)))
        (etypecase what
         (interpreted-code-location
      (let ((bpt (%make-breakpoint hook-function what kind info)))
        (etypecase what
         (interpreted-code-location

@@ -3215,13 +3396,14 @@
 (defstruct (function-end-cookie
            (:print-object (lambda (obj str)
                             (print-unreadable-object (obj str :type t))))
 (defstruct (function-end-cookie
            (:print-object (lambda (obj str)
                             (print-unreadable-object (obj str :type t))))

-           (:constructor make-function-end-cookie (bogus-lra debug-fun)))
-  ;; This is a pointer to the bogus-lra created for :function-end bpts.
+           (:constructor make-function-end-cookie (bogus-lra debug-fun))
+           (:copier nil))
+  ;; a pointer to the bogus-lra created for :FUNCTION-END breakpoints

   bogus-lra
   bogus-lra

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

   debug-fun)
 
   debug-fun)
 

-;;; This maps bogus-lra-components to cookies, so
+;;; This maps bogus-lra-components to cookies, so that

 ;;; HANDLE-FUNCTION-END-BREAKPOINT can find the appropriate cookie for the
 ;;; breakpoint hook.
 (defvar *function-end-cookies* (make-hash-table :test 'eq))
 ;;; HANDLE-FUNCTION-END-BREAKPOINT can find the appropriate cookie for the
 ;;; breakpoint hook.
 (defvar *function-end-cookies* (make-hash-table :test 'eq))

@@ -3264,16 +3446,17 @@
                (let ((fun (breakpoint-cookie-fun bpt)))
                  (when fun (funcall fun frame cookie))))))))))
 
                (let ((fun (breakpoint-cookie-fun bpt)))
                  (when fun (funcall fun frame cookie))))))))))
 

+;;; This takes a FUNCTION-END-COOKIE and a frame, and it returns
+;;; whether the cookie is still valid. A cookie becomes invalid when
+;;; the frame that established the cookie has exited. Sometimes cookie
+;;; holders are unaware of cookie invalidation because their
+;;; :FUNCTION-END breakpoint hooks didn't run due to THROW'ing.
+;;;
+;;; This takes a frame as an efficiency hack since the user probably
+;;; has a frame object in hand when using this routine, and it saves
+;;; repeated parsing of the stack and consing when asking whether a
+;;; series of cookies is valid.

 (defun function-end-cookie-valid-p (frame cookie)
 (defun function-end-cookie-valid-p (frame cookie)

-  #!+sb-doc
-  "This takes a function-end-cookie and a frame, and it returns whether the
-   cookie is still valid. A cookie becomes invalid when the frame that
-   established the cookie has exited. Sometimes cookie holders are unaware
-   of cookie invalidation because their :function-end breakpoint hooks didn't
-   run due to THROW'ing. This takes a frame as an efficiency hack since the
-   user probably has a frame object in hand when using this routine, and it
-   saves repeated parsing of the stack and consing when asking whether a
-   series of cookies is valid."

   (let ((lra (function-end-cookie-bogus-lra cookie))
        (lra-sc-offset (sb!c::compiled-debug-function-return-pc
                        (compiled-debug-function-compiler-debug-fun
   (let ((lra (function-end-cookie-bogus-lra cookie))
        (lra-sc-offset (sb!c::compiled-debug-function-return-pc
                        (compiled-debug-function-compiler-debug-fun

@@ -3287,14 +3470,14 @@
                                        #!+gengc sb!vm::ra-save-offset
                                        lra-sc-offset)))
        (return t)))))
                                        #!+gengc sb!vm::ra-save-offset
                                        lra-sc-offset)))
        (return t)))))

-
+\f

 ;;;; ACTIVATE-BREAKPOINT
 
 ;;;; ACTIVATE-BREAKPOINT
 

+;;; Cause the system to invoke the breakpoint's hook-function until
+;;; the next call to DEACTIVATE-BREAKPOINT or DELETE-BREAKPOINT. The
+;;; system invokes breakpoint hook functions in the opposite order
+;;; that you activate them.

 (defun activate-breakpoint (breakpoint)
 (defun activate-breakpoint (breakpoint)

-  #!+sb-doc
-  "This causes the system to invoke the breakpoint's hook-function until the
-   next call to DEACTIVATE-BREAKPOINT or DELETE-BREAKPOINT. The system invokes
-   breakpoint hook functions in the opposite order that you activate them."

   (when (eq (breakpoint-status breakpoint) :deleted)
     (error "cannot activate a deleted breakpoint: ~S" breakpoint))
   (unless (eq (breakpoint-status breakpoint) :active)
   (when (eq (breakpoint-status breakpoint) :deleted)
     (error "cannot activate a deleted breakpoint: ~S" breakpoint))
   (unless (eq (breakpoint-status breakpoint) :active)

@@ -3321,7 +3504,7 @@
         (compiled-debug-function
          (let ((starter (breakpoint-start-helper breakpoint)))
            (unless (eq (breakpoint-status starter) :active)
         (compiled-debug-function
          (let ((starter (breakpoint-start-helper breakpoint)))
            (unless (eq (breakpoint-status starter) :active)

-             ;; May already be active by some other :function-end breakpoint.
+             ;; may already be active by some other :FUNCTION-END breakpoint

              (activate-compiled-function-start-breakpoint starter)))
          (setf (breakpoint-status breakpoint) :active))
         (interpreted-debug-function
              (activate-compiled-function-start-breakpoint starter)))
          (setf (breakpoint-status breakpoint) :active))
         (interpreted-debug-function

@@ -3369,7 +3552,7 @@
    (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
 
 (defun deactivate-breakpoint (breakpoint)
 ;;;; DEACTIVATE-BREAKPOINT
 
 (defun deactivate-breakpoint (breakpoint)

@@ -3410,7 +3593,7 @@
          (delete-breakpoint-data data))))
   (setf (breakpoint-status breakpoint) :inactive)
   breakpoint)
          (delete-breakpoint-data data))))
   (setf (breakpoint-status breakpoint) :inactive)
   breakpoint)

-
+\f

 ;;;; BREAKPOINT-INFO
 
 (defun breakpoint-info (breakpoint)
 ;;;; BREAKPOINT-INFO
 
 (defun breakpoint-info (breakpoint)

@@ -3423,7 +3606,7 @@
   (let ((other (breakpoint-unknown-return-partner breakpoint)))
     (when other
       (setf (breakpoint-%info other) 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)

@@ -3457,7 +3640,7 @@
                   (breakpoint-what breakpoint))
                  nil))))))
   breakpoint)
                   (breakpoint-what breakpoint))
                  nil))))))
   breakpoint)

-
+\f

 ;;;; C call out stubs
 
 ;;; This actually installs the break instruction in the component. It
 ;;;; C call out stubs
 
 ;;; This actually installs the break instruction in the component. It

@@ -3518,6 +3701,7 @@
 ;;; 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)
 ;;; 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)

+  (/show0 "entering HANDLE-BREAKPOINT")

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

@@ -3541,6 +3725,7 @@
 ;;; This handles code-location and debug-function :FUNCTION-START
 ;;; breakpoints.
 (defun handle-breakpoint-aux (breakpoints data offset component signal-context)
 ;;; This handles code-location and debug-function :FUNCTION-START
 ;;; breakpoints.
 (defun handle-breakpoint-aux (breakpoints data offset component signal-context)

+  (/show0 "entering HANDLE-BREAKPOINT-AUX")

   (unless breakpoints
     (error "internal error: breakpoint that nobody wants"))
   (unless (member data *executing-breakpoint-hooks*)
   (unless breakpoints
     (error "internal error: breakpoint that nobody wants"))
   (unless (member data *executing-breakpoint-hooks*)

@@ -3583,6 +3768,7 @@
                   bpt)))))
 
 (defun handle-function-end-breakpoint (offset component context)
                   bpt)))))
 
 (defun handle-function-end-breakpoint (offset component context)

+  (/show0 "entering HANDLE-FUNCTION-END-BREAKPOINT")

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

@@ -3590,13 +3776,14 @@
              offset))
     (let ((breakpoints (breakpoint-data-breakpoints data)))
       (when breakpoints
              offset))
     (let ((breakpoints (breakpoint-data-breakpoints data)))
       (when breakpoints

-       (assert (eq (breakpoint-kind (car breakpoints)) :function-end))
+       (aver (eq (breakpoint-kind (car breakpoints)) :function-end))

        (handle-function-end-breakpoint-aux breakpoints data context)))))
 
 ;;; Either HANDLE-BREAKPOINT calls this for :FUNCTION-END breakpoints
 ;;; [old C code] or HANDLE-FUNCTION-END-BREAKPOINT calls this directly
 ;;; [new C code].
 (defun handle-function-end-breakpoint-aux (breakpoints data signal-context)
        (handle-function-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
 ;;; [new C code].
 (defun handle-function-end-breakpoint-aux (breakpoints data signal-context)

+  (/show0 "entering HANDLE-FUNCTION-END-BREAKPOINT-AUX")

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

@@ -3622,7 +3809,7 @@
                        #!+x86 sb!vm::ebx-offset)))
        (nargs (make-lisp-obj
                (sb!vm:context-register scp sb!vm::nargs-offset)))
                        #!+x86 sb!vm::ebx-offset)))
        (nargs (make-lisp-obj
                (sb!vm:context-register scp sb!vm::nargs-offset)))

-       (reg-arg-offsets '#.sb!vm::register-arg-offsets)
+       (reg-arg-offsets '#.sb!vm::*register-arg-offsets*)

        (results nil))
     (without-gcing
      (dotimes (arg-num nargs)
        (results nil))
     (without-gcing
      (dotimes (arg-num nargs)

@@ -3632,8 +3819,8 @@
               (stack-ref ocfp arg-num))
             results)))
     (nreverse results)))
               (stack-ref ocfp arg-num))
             results)))
     (nreverse results)))

-
-;;;; MAKE-BOGUS-LRA (used for :function-end breakpoints)
+\f
+;;;; MAKE-BOGUS-LRA (used for :FUNCTION-END breakpoints)

 
 (defconstant
   bogus-lra-constants
 
 (defconstant
   bogus-lra-constants