0.8.20.1: fun-name fun, debugger debugged
[sbcl.git] / src / code / debug-int.lisp
index ba25763..cf5a506 100644 (file)
    "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)
-  ((code-component :reader no-debug-info-code-component
-                  :initarg :code-component))
-  #!+sb-doc
-  (:documentation "There is no usable debugging information available.")
-  (:report (lambda (condition stream)
-            (fresh-line stream)
-            (format stream
-                    "no debug information available for ~S~%"
-                    (no-debug-info-code-component condition)))))
-
 (define-condition no-debug-fun-returns (debug-condition)
   ((debug-fun :reader no-debug-fun-returns-debug-fun
              :initarg :debug-fun))
@@ -64,8 +53,8 @@
                         (no-debug-fun-returns-debug-fun condition))))
               (format stream
                       "~&Cannot return values from ~:[frame~;~:*~S~] since ~
-                       the debug information lacks details about returning ~
-                       values here."
+                        the debug information lacks details about returning ~
+                        values here."
                       fun)))))
 
 (define-condition no-debug-blocks (debug-condition)
            (breakpoint-data-offset obj))))
 
 (defstruct (breakpoint (:constructor %make-breakpoint
-                                    (hook-function what kind %info))
+                                    (hook-fun 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 :FUN-END breakpoints
-  ;; as values to return for the function containing the breakpoint.
-  ;; :FUN-END breakpoint hook-functions also take a cookie
-  ;; argument. See COOKIE-FUN slot.
-  (hook-function nil :type function)
+  ;; list of values. Values are supplied for :FUN-END breakpoints as
+  ;; values to return for the function containing the breakpoint.
+  ;; :FUN-END breakpoint hook functions also take a cookie argument.
+  ;; See the COOKIE-FUN slot.
+  (hook-fun (required-arg) :type function)
   ;; CODE-LOCATION or DEBUG-FUN
   (what nil :type (or code-location debug-fun))
   ;; :CODE-LOCATION, :FUN-START, or :FUN-END for that kind
   ;; 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.
+  ;; the cookie, and the hook function takes the cookie too.
   (cookie-fun nil :type (or null function))
   ;; This slot users can set with whatever information they find useful.
   %info)
   ;; 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,
+  ;; :UNPARSED slot, if the data is unavailable, then this becomes T,
   ;; and the code-location is unknown. If the data is available, this
-  ;; becomes nil, a known location. We can't use a separate type
+  ;; becomes NIL, a known location. We can't use a separate type
   ;; code-location for this since we must return code-locations before
   ;; we can tell whether they're known or unknown. For example, when
   ;; parsing the stack, we don't want to unpack all the variables and
 ;;;; frames
 
 ;;; This is used in FIND-ESCAPED-FRAME and with the bogus components
-;;; and LRAs used for :FUN-END breakpoints. When a components
+;;; and LRAs used for :FUN-END breakpoints. When a component's
 ;;; 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.
 (defun get-lisp-obj-address (thing) (get-lisp-obj-address thing))
 (defun fun-word-offset (fun) (fun-word-offset fun))
 
-#!-sb-fluid (declaim (inline cstack-pointer-valid-p))
-(defun cstack-pointer-valid-p (x)
+#!-sb-fluid (declaim (inline control-stack-pointer-valid-p))
+(defun control-stack-pointer-valid-p (x)
   (declare (type system-area-pointer x))
-  #!-x86 ; stack grows toward high address values
-  (and (sap< x (current-sp))
-       (sap<= (int-sap control-stack-start)
-             x)
-       (zerop (logand (sap-int x) #b11)))
-  #!+x86 ; stack grows toward low address values
-  (and (sap>= x (current-sp))
-       (sap> (int-sap control-stack-end) x)
-       (zerop (logand (sap-int x) #b11))))
-
-#!+x86
+  (let* (#!-stack-grows-downward-not-upward
+        (control-stack-start
+         (descriptor-sap *control-stack-start*))
+        #!+stack-grows-downward-not-upward
+        (control-stack-end
+         (descriptor-sap *control-stack-end*)))
+    #!-stack-grows-downward-not-upward
+    (and (sap< x (current-sp))
+        (sap<= control-stack-start x)
+        (zerop (logand (sap-int x) #b11)))
+    #!+stack-grows-downward-not-upward
+    (and (sap>= x (current-sp))
+        (sap> control-stack-end x)
+        (zerop (logand (sap-int x) #b11)))))
+
 (sb!alien:define-alien-routine component-ptr-from-pc (system-area-pointer)
   (pc system-area-pointer))
 
-#!+x86
 (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-lowtag)))
 
-;;;; X86 support
+;;;; (OR X86 X86-64) support
 
-#!+x86
+#!+(or x86 x86-64)
 (progn
 
 (defun compute-lra-data-from-pc (pc)
 (defun ra-pointer-valid-p (ra)
   (declare (type system-area-pointer ra))
   (and
-   ;; Not the first page which is unmapped.
+   ;; not the first page (which is unmapped)
+   ;;
+   ;; FIXME: Where is this documented? Is it really true of every CPU
+   ;; architecture? Is it even necessarily true in current SBCL?
    (>= (sap-int ra) 4096)
-   ;; Not a Lisp stack pointer.
-   (not (cstack-pointer-valid-p ra))))
+   ;; not a Lisp stack pointer
+   (not (control-stack-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
 (defun x86-call-context (fp &key (depth 0))
   (declare (type system-area-pointer fp)
           (fixnum depth))
-  ;;(format t "*CC ~S ~S~%" fp depth)
+;;  (format t "*CC ~S ~S~%" fp depth)
   (cond
-   ((not (cstack-pointer-valid-p fp))
+   ((not (control-stack-pointer-valid-p fp))
     #+nil (format t "debug invalid fp ~S~%" fp)
     nil)
    (t
     ;; Check the two possible frame pointers.
-    (let ((lisp-ocfp (sap-ref-sap fp (- (* (1+ ocfp-save-offset) 4))))
+    (let ((lisp-ocfp (sap-ref-sap fp (- (* (1+ ocfp-save-offset)
+                                          sb!vm::n-word-bytes))))
          (lisp-ra (sap-ref-sap fp (- (* (1+ return-pc-save-offset)
-                                        4))))
+                                        sb!vm::n-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)
+      #+nil (format t "  lisp-ocfp=~S~%  lisp-ra=~S~%  c-ocfp=~S~%  c-ra=~S~%"
+             lisp-ocfp lisp-ra c-ocfp c-ra)
+      (cond ((and (sap> lisp-ocfp fp) (control-stack-pointer-valid-p lisp-ocfp)
                  (ra-pointer-valid-p lisp-ra)
-                 (sap> c-ocfp fp) (cstack-pointer-valid-p c-ocfp)
+                 (sap> c-ocfp fp) (control-stack-pointer-valid-p c-ocfp)
                  (ra-pointer-valid-p c-ra))
             #+nil (format t
                           "*C Both valid ~S ~S ~S ~S~%"
                                (format t
                                       "debug: both still valid ~S ~S ~S ~S~%"
                                        lisp-ocfp lisp-ra c-ocfp c-ra))
-                     #+freebsd
+                     #!+freebsd
                      (if (sap> lisp-ocfp c-ocfp)
                         (values lisp-ra lisp-ocfp)
                        (values c-ra c-ocfp))
-                       #-freebsd
+                       #!-freebsd
                        (values lisp-ra lisp-ocfp))
                     (lisp-path-fp
                      ;; The lisp convention is looking good.
                      #+nil (format t "debug: no valid2 fp found ~S ~S~%"
                                    lisp-ocfp c-ocfp)
                      nil))))
-           ((and (sap> lisp-ocfp fp) (cstack-pointer-valid-p lisp-ocfp)
+           ((and (sap> lisp-ocfp fp) (control-stack-pointer-valid-p lisp-ocfp)
                  (ra-pointer-valid-p lisp-ra))
             ;; The lisp convention is looking good.
             #+nil (format t "*C lisp-ocfp ~S ~S~%" lisp-ocfp lisp-ra)
             (values lisp-ra lisp-ocfp))
-           ((and (sap> c-ocfp fp) (cstack-pointer-valid-p c-ocfp)
+           ((and (sap> c-ocfp fp) (control-stack-pointer-valid-p c-ocfp)
                  #!-linux (ra-pointer-valid-p c-ra))
             ;; The C convention is looking good.
             #+nil (format t "*C c-ocfp ~S ~S~%" c-ocfp c-ra)
                      frame)))
                  (bogus-debug-fun
                   (let ((fp (frame-pointer frame)))
-                    (when (cstack-pointer-valid-p fp)
-                      #!+x86
+                    (when (control-stack-pointer-valid-p fp)
+                      #!+(or x86 x86-64)
                        (multiple-value-bind (ra ofp) (x86-call-context fp)
-                         (compute-calling-frame ofp ra frame))
-                       #!-x86
+                        (and ra (compute-calling-frame ofp ra frame)))
+                       #!-(or x86 x86-64)
                       (compute-calling-frame
                        #!-alpha
                        (sap-ref-sap fp (* ocfp-save-offset
 ;;; Get the old FP or return PC out of FRAME. STACK-SLOT is the
 ;;; standard save location offset on the stack. LOC is the saved
 ;;; SC-OFFSET describing the main location.
-#!-x86
+#!-(or x86 x86-64)
 (defun get-context-value (frame stack-slot loc)
   (declare (type compiled-frame frame) (type unsigned-byte stack-slot)
           (type sb!c:sc-offset loc))
     (if escaped
        (sub-access-debug-var-slot pointer loc escaped)
        (stack-ref pointer stack-slot))))
-#!+x86
+#!+(or x86 x86-64)
 (defun get-context-value (frame stack-slot loc)
   (declare (type compiled-frame frame) (type unsigned-byte stack-slot)
           (type sb!c:sc-offset loc))
          (#.ocfp-save-offset
           (stack-ref pointer stack-slot))
          (#.lra-save-offset
-          (sap-ref-sap pointer (- (* (1+ stack-slot) 4))))))))
+          (sap-ref-sap pointer (- (* (1+ stack-slot)
+                                     sb!vm::n-word-bytes))))))))
 
-#!-x86
+#!-(or x86 x86-64)
 (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))
        (sub-set-debug-var-slot pointer loc value escaped)
        (setf (stack-ref pointer stack-slot) value))))
 
-#!+x86
+#!+(or x86 x86-64)
 (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))
          (#.ocfp-save-offset
           (setf (stack-ref pointer stack-slot) value))
          (#.lra-save-offset
-          (setf (sap-ref-sap pointer (- (* (1+ stack-slot) 4))) value))))))
+          (setf (sap-ref-sap pointer (- (* (1+ stack-slot)
+                                           sb!vm::n-word-bytes))) value))))))
+
+(defun foreign-function-backtrace-name (sap)
+  (let ((name (foreign-symbol-in-address sap)))
+    (if name
+       (format nil "foreign function: ~A" name)
+       (format nil "foreign function: #x~X" (sap-int sap)))))
 
 ;;; This returns a frame for the one existing in time immediately
 ;;; prior to the frame referenced by current-fp. This is current-fp's
 ;;; 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.
-#!-x86
+#!-(or x86 x86-64)
 (defun compute-calling-frame (caller lra up-frame)
   (declare (type system-area-pointer caller))
-  (when (cstack-pointer-valid-p caller)
+  (when (control-stack-pointer-valid-p caller)
     (multiple-value-bind (code pc-offset escaped)
        (if lra
            (multiple-value-bind (word-offset code)
                           "undefined function"))
                         (:foreign-function
                          (make-bogus-debug-fun
-                          "foreign function call land"))
+                          (foreign-function-backtrace-name
+                           (int-sap (get-lisp-obj-address lra)))))
                         ((nil)
                          (make-bogus-debug-fun
                           "bogus stack frame"))
                                                        escaped)
                                 (if up-frame (1+ (frame-number up-frame)) 0)
                                 escaped))))))
-#!+x86
+#!+(or x86 x86-64)
 (defun compute-calling-frame (caller ra up-frame)
   (declare (type system-area-pointer caller ra))
   (/noshow0 "entering COMPUTE-CALLING-FRAME")
-  (when (cstack-pointer-valid-p caller)
+  (when (control-stack-pointer-valid-p caller)
     (/noshow0 "in WHEN")
     ;; First check for an escaped frame.
     (multiple-value-bind (code pc-offset escaped) (find-escaped-frame caller)
       (/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))
                                code (1+ real-lra-slot)))
               (setq code (code-header-ref code real-lra-slot))
               (aver code)))
-           (t
-            (/noshow0 "in T clause")
-            ;; not escaped
+           ((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))))
-
+                    pc-offset 0))))
       (let ((d-fun (case code
                     (:undefined-function
                      (make-bogus-debug-fun
                       "undefined function"))
                     (:foreign-function
                      (make-bogus-debug-fun
-                      "foreign function call land"))
+                      (foreign-function-backtrace-name ra)))
                     ((nil)
                      (make-bogus-debug-fun
                       "bogus stack frame"))
                             (if up-frame (1+ (frame-number up-frame)) 0)
                             escaped)))))
 
-#!+x86
+(defun nth-interrupt-context (n)
+  (declare (type (unsigned-byte 32) n)
+          (optimize (speed 3) (safety 0)))
+  (sb!alien:sap-alien (sb!vm::current-thread-offset-sap 
+                      (+ sb!vm::thread-interrupt-contexts-offset n))
+                     (* os-context-t)))
+
+#!+(or x86 x86-64)
 (defun find-escaped-frame (frame-pointer)
   (declare (type system-area-pointer frame-pointer))
   (/noshow0 "entering FIND-ESCAPED-FRAME")
   (dotimes (index *free-interrupt-context-index* (values nil 0 nil))
-    (sb!alien:with-alien
-       ((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 (nth-interrupt-context index)))
        (/noshow0 "got CONTEXT")
        (when (= (sap-int frame-pointer)
                 (sb!vm:context-register context sb!vm::cfp-offset))
                         pc-offset code))
               (/noshow0 "returning from FIND-ESCAPED-FRAME")
               (return
-               (values code pc-offset context))))))))))
+              (values code pc-offset context)))))))))
 
-#!-x86
+#!-(or x86 x86-64)
 (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)))))))))))
+    (let ((scp (nth-interrupt-context 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))
+            (let ((code-size (* (code-header-ref code 
+                                                  sb!vm:code-code-size-slot)
+                                 sb!vm:n-word-bytes)))
+               (unless (<= 0 pc-offset code-size)
+                 ;; We were in an assembly routine.
+                 (multiple-value-bind (new-pc-offset computed-return)
+                     (find-pc-from-assembly-fun code scp)
+                   (setf pc-offset new-pc-offset)
+                   (unless (<= 0 pc-offset code-size)
+                     (cerror
+                     "Set PC-OFFSET to zero and continue backtrace."
+                     'bug
+                     :format-control
+                     "~@<PC-OFFSET (~D) not in code object. Frame details:~
+                       ~2I~:@_PC: #X~X~:@_CODE: ~S~:@_CODE FUN: ~S~:@_LRA: ~
+                       #X~X~:@_COMPUTED RETURN: #X~X.~:>"
+                     :format-arguments
+                     (list pc-offset
+                           (sap-int (sb!vm:context-pc scp))
+                           code
+                           (%code-entry-points code)
+                           (sb!vm:context-register scp sb!vm::lra-offset)
+                           computed-return))
+                     ;; We failed to pinpoint where PC is, but set
+                     ;; pc-offset to 0 to keep the backtrace from
+                     ;; exploding.
+                    (setf pc-offset 0)))))
+            (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))))))))))
+
+#!-(or x86 x86-64)
+(defun find-pc-from-assembly-fun (code scp)
+  "Finds the PC for the return from an assembly routine properly.
+For some architectures (such as PPC) this will not be the $LRA
+register."
+  (let ((return-machine-address (sb!vm::return-machine-address scp))
+        (code-header-len (* (get-header-data code) sb!vm:n-word-bytes)))
+    (values (- return-machine-address
+              (- (get-lisp-obj-address code)
+                 sb!vm:other-pointer-lowtag) 
+              code-header-len)
+           return-machine-address)))
 
 ;;; Find the code object corresponding to the object represented by
 ;;; bits and return it. We assume bogus functions correspond to the
 \f
 ;;;; frame utilities
 
-;;; This returns a COMPILED-DEBUG-FUN for code and pc. We fetch the
+;;; This returns a COMPILED-DEBUG-FUN for COMPONENT 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 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)
-      (debug-signal 'no-debug-info :code-component component))
+      ((not info)
+       ;; FIXME: It seems that most of these (at least on x86) are
+       ;; actually assembler routines, and could be named by looking
+       ;; at the sb-fasl:*assembler-routines*.
+       (make-bogus-debug-fun "no debug information for frame"))
      ((eq info :bogus-lra)
       (make-bogus-debug-fun "function end breakpoint"))
      (t
-      (let* ((fun-map (get-debug-info-fun-map info))
+      (let* ((fun-map (sb!c::compiled-debug-info-fun-map info))
             (len (length fun-map)))
        (declare (type simple-vector fun-map))
        (if (= len 1)
                       (sap-ref-32 catch
                                   (* sb!vm:catch-block-current-cont-slot
                                      sb!vm:n-word-bytes))))
-           (let* (#!-x86
+           (let* (#!-(or x86 x86-64)
                   (lra (stack-ref catch sb!vm:catch-block-entry-pc-slot))
-                  #!+x86
+                  #!+(or x86 x86-64)
                   (ra (sap-ref-sap
                        catch (* sb!vm:catch-block-entry-pc-slot
                                 sb!vm:n-word-bytes)))
-                  #!-x86
+                  #!-(or x86 x86-64)
                   (component
                    (stack-ref catch sb!vm:catch-block-current-code-slot))
-                  #!+x86
+                  #!+(or x86 x86-64)
                   (component (component-from-component-ptr
                               (component-ptr-from-pc ra)))
                   (offset
-                   #!-x86
+                   #!-(or x86 x86-64)
                    (* (- (1+ (get-header-data lra))
                          (get-header-data component))
                       sb!vm:n-word-bytes)
-                   #!+x86
+                   #!+(or x86 x86-64)
                    (- (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
+             (push (cons #!-(or x86 x86-64)
                          (stack-ref catch sb!vm:catch-block-tag-slot)
-                         #!+x86
+                         #!+(or x86 x86-64)
                          (make-lisp-obj
-                          (sap-ref-32 catch (* sb!vm:catch-block-tag-slot
-                                               sb!vm:n-word-bytes)))
+                          (sap-ref-word catch (* sb!vm:catch-block-tag-slot
+                                                 sb!vm:n-word-bytes)))
                          (make-compiled-code-location
                           offset (frame-debug-fun frame)))
                    reversed-result)))
 ;;; 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)
+(defmacro do-debug-fun-vars ((var debug-fun &optional result) &body body)
   (let ((vars (gensym))
        (i (gensym)))
     `(let ((,vars (debug-fun-debug-vars ,debug-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)
+  (declare (type debug-fun debug-fun))
   (etypecase debug-fun
     (compiled-debug-fun
      (sb!c::compiled-debug-fun-name
      (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)
+    (#.sb!vm:simple-fun-header-widetag
       (let* ((name (%simple-fun-name fun))
             (component (fun-code-header fun))
             (res (find-if
                     (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
+                  (sb!c::compiled-debug-info-fun-map
                    (%code-debug-info component)))))
        (if res
            (make-compiled-debug-fun res component)
 ;;; 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)
+(defun debug-fun-symbol-vars (debug-fun symbol)
   (let ((vars (ambiguous-debug-vars debug-fun (symbol-name symbol)))
        (package (and (symbol-package symbol)
                      (package-name (symbol-package symbol)))))
     (if variables
        (let* ((len (length variables))
               (prefix-len (length name-prefix-string))
-              (pos (find-variable name-prefix-string variables len))
+              (pos (find-var name-prefix-string variables len))
               (res nil))
          (when pos
            ;; Find names from pos to variable's len that contain prefix.
            (setq res (nreverse res)))
          res))))
 
-;;; This returns a position in variables for one containing name as an
-;;; initial substring. End is the length of variables if supplied.
-(defun find-variable (name variables &optional end)
+;;; This returns a position in VARIABLES for one containing NAME as an
+;;; initial substring. END is the length of VARIABLES if supplied.
+(defun find-var (name variables &optional end)
   (declare (simple-vector variables)
           (simple-string name))
   (let ((name-len (length name)))
     (position name variables
-             :test #'(lambda (x y)
-                       (let* ((y (debug-var-symbol-name y))
-                              (y-len (length y)))
-                         (declare (simple-string y))
-                         (and (>= y-len name-len)
-                              (string= x y :end1 name-len :end2 name-len))))
+             :test (lambda (x y)
+                     (let* ((y (debug-var-symbol-name y))
+                            (y-len (length y)))
+                       (declare (simple-string y))
+                       (and (>= y-len name-len)
+                            (string= x y :end1 name-len :end2 name-len))))
              :end (or end (length variables)))))
 
 ;;; Return a list representing the lambda-list for DEBUG-FUN. The
                 ;; optional. Stick the extra var in the result
                 ;; element representing the keyword or optional,
                 ;; which is the previous one.
+                 ;;
+                 ;; FIXME: NCONC used for side-effect: the effect is defined,
+                 ;; but this is bad style no matter what.
                 (nconc (car res)
                        (list (compiled-debug-fun-lambda-list-var
                               args (incf i) vars))))
                       (list successors))
              (dotimes (k (ldb sb!c::compiled-debug-block-nsucc-byte
                               succ-and-flags))
-               (push (sb!c::read-var-integer blocks i) successors))
+               (push (sb!c:read-var-integer blocks i) successors))
              (let* ((locations
-                     (dotimes (k (sb!c::read-var-integer blocks i)
+                     (dotimes (k (sb!c:read-var-integer blocks i)
                                  (result locations-buffer))
                        (let ((kind (svref sb!c::*compiled-code-location-kinds*
                                           (aref+ blocks i)))
                              (pc (+ last-pc
-                                    (sb!c::read-var-integer blocks i)))
+                                    (sb!c:read-var-integer blocks i)))
                              (tlf-offset (or tlf-number
-                                             (sb!c::read-var-integer blocks
-                                                                     i)))
-                             (form-number (sb!c::read-var-integer blocks i))
-                             (live-set (sb!c::read-packed-bit-vector
+                                             (sb!c:read-var-integer blocks i)))
+                             (form-number (sb!c:read-var-integer blocks i))
+                             (live-set (sb!c:read-packed-bit-vector
                                         live-set-len blocks i)))
                          (vector-push-extend (make-known-code-location
                                               pc debug-fun tlf-offset
   (let* ((len (length vars))
         (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
-                   ;; 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..
-                   ;; -- WHN 20000129
-                   ;;
-                   ;; FIXME: Maybe this could be fixed by moving the
-                   ;; whole debug-int.lisp file to warm init? (after
-                   ;; which dumping a #.(FIND-PACKAGE ..) expression
-                   ;; 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.
-                   (or (find-package "SB-DEBUG")
-                       (find-package "SB!DEBUG")))))))
+      (without-package-locks
+        (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 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..
+                      ;; -- WHN 20000129
+                      ;;
+                      ;; FIXME: Maybe this could be fixed by moving the
+                      ;; whole debug-int.lisp file to warm init? (after
+                      ;; which dumping a #.(FIND-PACKAGE ..) expression
+                      ;; 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.
+                      (or (find-package "SB-DEBUG")
+                          (find-package "SB!DEBUG"))))))))
 
 ;;; Parse the packed representation of DEBUG-VARs from
 ;;; DEBUG-FUN's SB!C::COMPILED-DEBUG-FUN, returning a vector
 (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))
+        (packed-vars (sb!c::compiled-debug-fun-vars cdebug-fun))
         (args-minimal (eq (sb!c::compiled-debug-fun-arguments cdebug-fun)
                           :minimal)))
     (when packed-vars
                                                         save-sc-offset)
                                buffer)))))))
 \f
-;;;; unpacking minimal debug functions
-
-;;; 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))
-  (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
 
 ;;; If we're sure of whether code-location is known, return T or NIL.
              (unless (fill-in-code-location code-location)
                ;; This check should be unnecessary. We're missing
                ;; debug info the compiler should have dumped.
-               (error "internal error: unknown code location"))
+               (bug "unknown code location"))
              (code-location-%tlf-offset code-location))
             ;; (There used to be more cases back before sbcl-0.7.0,,
             ;; when we did special tricks to debug the IR1
              (unless (fill-in-code-location code-location)
                ;; This check should be unnecessary. We're missing
                ;; debug info the compiler should have dumped.
-               (error "internal error: unknown code location"))
+               (bug "unknown code location"))
              (code-location-%form-number code-location))
             ;; (There used to be more cases back before sbcl-0.7.0,,
             ;; when we did special tricks to debug the IR1
             ((not (fill-in-code-location code-location))
              ;; This check should be unnecessary. We're missing
              ;; debug info the compiler should have dumped.
-             (error "internal error: unknown code location"))
+             (bug "unknown code location"))
             (t
              (compiled-code-location-kind code-location)))))
     ;; (There used to be more cases back before sbcl-0.7.0,,
                 ;;
                 ;; FIXME: This error and comment happen over and over again.
                 ;; Make them a shared function.
-                (error "internal error: unknown code location"))
+                (bug "unknown code location"))
               (compiled-code-location-%live-set code-location))
              (t live-set)))))
 
        ;; interpreter.)
        ))
     ;; (There used to be more cases back before sbcl-0.7.0,,
-    ;; when we did special tricks to debug the IR1
-    ;; interpreter.)
+    ;; when we did special tricks to debug IR1-interpreted code.)
     ))
 (defun sub-compiled-code-location= (obj1 obj2)
   (= (compiled-code-location-pc obj1)
 (defun make-valid-lisp-obj (val)
   (if (or
        ;; fixnum
-       (zerop (logand val 3))
+       (zerop (logand val sb!vm:fixnum-tag-mask))
        ;; character
-       (and (zerop (logand val #xffff0000)) ; Top bits zero
-           (= (logand val #xff) sb!vm:base-char-widetag)) ; char tag
+       (and (zerop (logandc2 val #x1fffffff)) ; Top bits zero
+           (= (logand val #xff) sb!vm:character-widetag)) ; char tag
        ;; unbound marker
        (= val sb!vm:unbound-marker-widetag)
        ;; pointer
       (make-lisp-obj val)
       :invalid-object))
 
-#!-x86
+#!-(or x86 x86-64)
 (defun sub-access-debug-var-slot (fp sc-offset &optional escaped)
   (macrolet ((with-escaped-value ((var) &body forms)
                `(if escaped
        (sb!sys:without-gcing
         (with-escaped-value (val) (sb!kernel:make-lisp-obj val))))
                             
-      (#.sb!vm:base-char-reg-sc-number
+      (#.sb!vm:character-reg-sc-number
        (with-escaped-value (val)
          (code-char val)))
       (#.sb!vm:sap-reg-sc-number
             (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)
+             escaped (+ (sb!c:sc-offset-offset sc-offset) #!+sparc 2 #!-sparc 1)
              'double-float))
            :invalid-value-for-unescaped-register-storage))
       #!+long-float
                                       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
+      (#.sb!vm:character-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!sys:sap-ref-sap nfp (* (sb!c:sc-offset-offset sc-offset)
                                     sb!vm:n-word-bytes)))))))
 
-#!+x86
+#!+(or x86 x86-64)
 (defun sub-access-debug-var-slot (fp sc-offset &optional escaped)
   (declare (type system-area-pointer fp))
   (macrolet ((with-escaped-value ((var) &body forms)
        (without-gcing
        (with-escaped-value (val)
          (make-valid-lisp-obj val))))
-      (#.sb!vm:base-char-reg-sc-number
+      (#.sb!vm:character-reg-sc-number
        (with-escaped-value (val)
         (code-char val)))
       (#.sb!vm:sap-reg-sc-number
                               sb!vm:n-word-bytes)))))
       (#.sb!vm:control-stack-sc-number
        (stack-ref fp (sb!c:sc-offset-offset sc-offset)))
-      (#.sb!vm:base-char-stack-sc-number
+      (#.sb!vm:character-stack-sc-number
        (code-char
-       (sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
-                            sb!vm:n-word-bytes)))))
+       (sap-ref-word fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
+                              sb!vm:n-word-bytes)))))
       (#.sb!vm:unsigned-stack-sc-number
-       (sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
-                           sb!vm:n-word-bytes))))
+       (sap-ref-word fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
+                             sb!vm:n-word-bytes))))
       (#.sb!vm:signed-stack-sc-number
-       (signed-sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
-                                  sb!vm:n-word-bytes))))
+       (signed-sap-ref-word fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
+                                    sb!vm:n-word-bytes))))
       (#.sb!vm:sap-stack-sc-number
        (sap-ref-sap fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
                             sb!vm:n-word-bytes)))))))
             (compiled-debug-var-sc-offset debug-var))
         value))))
 
-#!-x86
+#!-(or x86 x86-64)
 (defun sub-set-debug-var-slot (fp sc-offset value &optional escaped)
   (macrolet ((set-escaped-value (val)
               `(if escaped
        (without-gcing
        (set-escaped-value
          (get-lisp-obj-address value))))
-      (#.sb!vm:base-char-reg-sc-number
+      (#.sb!vm:character-reg-sc-number
        (set-escaped-value (char-code value)))
       (#.sb!vm:sap-reg-sc-number
        (set-escaped-value (sap-int value)))
               (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
+      (#.sb!vm:character-stack-sc-number
        (with-nfp (nfp)
         (setf (sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset)
                                         sb!vm:n-word-bytes))
                                   sb!vm:n-word-bytes))
               (the system-area-pointer value)))))))
 
-#!+x86
+#!+(or x86 x86-64)
 (defun sub-set-debug-var-slot (fp sc-offset value &optional escaped)
   (macrolet ((set-escaped-value (val)
               `(if escaped
        (without-gcing
        (set-escaped-value
          (get-lisp-obj-address value))))
-      (#.sb!vm:base-char-reg-sc-number
+      (#.sb!vm:character-reg-sc-number
        (set-escaped-value (char-code value)))
       (#.sb!vm:sap-reg-sc-number
        (set-escaped-value (sap-int value)))
             (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:n-word-bytes)))
+      (#.sb!vm:character-stack-sc-number
+       (setf (sap-ref-word fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
+                                   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))
-                                        sb!vm:n-word-bytes)))
-            (the (unsigned-byte 32) value)))
+       (setf (sap-ref-word fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
+                                   sb!vm:n-word-bytes)))
+            (the sb!vm:word value)))
       (#.sb!vm:signed-stack-sc-number
-       (setf (signed-sap-ref-32
+       (setf (signed-sap-ref-word
              fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
                       sb!vm:n-word-bytes)))
-            (the (signed-byte 32) value)))
+            (the (signed-byte #.sb!vm:n-word-bits) value)))
       (#.sb!vm:sap-stack-sc-number
        (setf (sap-ref-sap fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
                                          sb!vm:n-word-bytes)))
       (debug-signal 'no-debug-vars :debug-fun fun))
     (sb!int:collect ((binds)
                     (specs))
-      (do-debug-fun-variables (var fun)
+      (do-debug-fun-vars (var fun)
        (let ((validity (debug-var-validity var loc)))
          (unless (eq validity :invalid)
            (let* ((sym (debug-var-symbol var))
                            (declare (ignorable ,n-frame))
                            (symbol-macrolet ,(specs) ,form))
                         'function)))
-       #'(lambda (frame)
-           ;; 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-FUN is the same as loc's.
-           (unless (code-location= (frame-code-location frame) loc)
-             (debug-signal 'frame-fun-mismatch
-                           :code-location loc :form form :frame frame))
-           (funcall res frame))))))
+       (lambda (frame)
+         ;; 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-FUN is the
+         ;; same as LOC's.
+         (unless (code-location= (frame-code-location frame) loc)
+           (debug-signal 'frame-fun-mismatch
+                         :code-location loc :form form :frame frame))
+         (funcall res 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.
+;;; the breakpoint, the system calls HOOK-FUN. HOOK-FUN 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.
+;;; HOOK-FUN. 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-FUN 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.
 ;;;
 ;;; function.
 ;;;
 ;;; Signal an error if WHAT is an unknown code-location.
-(defun make-breakpoint (hook-function what
+(defun make-breakpoint (hook-fun what
                        &key (kind :code-location) info fun-end-cookie)
   (etypecase what
     (code-location
        (error "cannot make a breakpoint at an unknown code location: ~S"
              what))
      (aver (eq kind :code-location))
-     (let ((bpt (%make-breakpoint hook-function what kind info)))
+     (let ((bpt (%make-breakpoint hook-fun what kind info)))
        (etypecase what
         (compiled-code-location
          ;; This slot is filled in due to calling CODE-LOCATION-UNKNOWN-P.
          (when (eq (compiled-code-location-kind what) :unknown-return)
-           (let ((other-bpt (%make-breakpoint hook-function what
+           (let ((other-bpt (%make-breakpoint hook-fun what
                                               :unknown-return-partner
                                               info)))
              (setf (breakpoint-unknown-return-partner bpt) other-bpt)
     (compiled-debug-fun
      (ecase kind
        (:fun-start
-       (%make-breakpoint hook-function what kind info))
+       (%make-breakpoint hook-fun what kind info))
        (:fun-end
        (unless (eq (sb!c::compiled-debug-fun-returns
                     (compiled-debug-fun-compiler-debug-fun what))
                    :standard)
          (error ":FUN-END breakpoints are currently unsupported ~
-                 for the known return convention."))
+                  for the known return convention."))
 
-       (let* ((bpt (%make-breakpoint hook-function what kind info))
+       (let* ((bpt (%make-breakpoint hook-fun what kind info))
               (starter (compiled-debug-fun-end-starter what)))
          (unless starter
            (setf starter (%make-breakpoint #'list what :fun-start nil))
-           (setf (breakpoint-hook-function starter)
+           (setf (breakpoint-hook-fun starter)
                  (fun-end-starter-hook starter what))
            (setf (compiled-debug-fun-end-starter what) starter))
          (setf (breakpoint-start-helper bpt) starter)
 (defun fun-end-starter-hook (starter-bpt debug-fun)
   (declare (type breakpoint starter-bpt)
           (type compiled-debug-fun debug-fun))
-  #'(lambda (frame breakpoint)
-      (declare (ignore breakpoint)
-              (type frame frame))
-      (let ((lra-sc-offset
-            (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
-                               lra-save-offset
-                               lra-sc-offset))
-         (setf (get-context-value frame
-                                  lra-save-offset
-                                  lra-sc-offset)
-               lra)
-         (let ((end-bpts (breakpoint-%info starter-bpt)))
-           (let ((data (breakpoint-data component offset)))
-             (setf (breakpoint-data-breakpoints data) end-bpts)
-             (dolist (bpt end-bpts)
-               (setf (breakpoint-internal-data bpt) data)))
-           (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))))))))))
+  (lambda (frame breakpoint)
+    (declare (ignore breakpoint)
+            (type frame frame))
+    (let ((lra-sc-offset
+          (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
+                             lra-save-offset
+                             lra-sc-offset))
+       (setf (get-context-value frame
+                                lra-save-offset
+                                lra-sc-offset)
+             lra)
+       (let ((end-bpts (breakpoint-%info starter-bpt)))
+         (let ((data (breakpoint-data component offset)))
+           (setf (breakpoint-data-breakpoints data) end-bpts)
+           (dolist (bpt end-bpts)
+             (setf (breakpoint-internal-data bpt) data)))
+         (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))))))))))
 
 ;;; This takes a FUN-END-COOKIE and a frame, and it returns
 ;;; whether the cookie is still valid. A cookie becomes invalid when
     (do ((frame frame (frame-down frame)))
        ((not frame) nil)
       (when (and (compiled-frame-p frame)
-                 (#-x86 eq #+x86 sap=
+                 (#!-(or x86 x86-64) eq #!+(or x86 x86-64) sap=
                  lra
                  (get-context-value frame lra-save-offset lra-sc-offset)))
        (return t)))))
 \f
 ;;;; ACTIVATE-BREAKPOINT
 
-;;; Cause the system to invoke the breakpoint's hook-function until
+;;; 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.
 \f
 ;;;; DEACTIVATE-BREAKPOINT
 
-;;; Stop the system from invoking the breakpoint's hook-function.
+;;; Stop the system from invoking the breakpoint's hook function.
 (defun deactivate-breakpoint (breakpoint)
   (when (eq (breakpoint-status breakpoint) :active)
     (without-interrupts
 (defun deactivate-compiled-breakpoint (breakpoint)
   (if (eq (breakpoint-kind breakpoint) :fun-end)
       (let ((starter (breakpoint-start-helper breakpoint)))
-       (unless (find-if #'(lambda (bpt)
-                            (and (not (eq bpt breakpoint))
-                                 (eq (breakpoint-status bpt) :active)))
+       (unless (find-if (lambda (bpt)
+                          (and (not (eq bpt breakpoint))
+                               (eq (breakpoint-status bpt) :active)))
                         (breakpoint-%info starter))
          (deactivate-compiled-breakpoint starter)))
       (let* ((data (breakpoint-internal-data breakpoint))
 ;;; returns the overwritten bits. You must call this in a context in
 ;;; which GC is disabled, so that Lisp doesn't move objects around
 ;;; that C is pointing to.
-(sb!alien:define-alien-routine "breakpoint_install" sb!c-call:unsigned-long
-  (code-obj sb!c-call:unsigned-long)
-  (pc-offset sb!c-call:int))
+(sb!alien:define-alien-routine "breakpoint_install" sb!alien:unsigned-long
+  (code-obj sb!alien:unsigned-long)
+  (pc-offset sb!alien:int))
 
 ;;; This removes the break instruction and replaces the original
 ;;; instruction. You must call this in a context in which GC is disabled
 ;;; so Lisp doesn't move objects around that C is pointing to.
-(sb!alien:define-alien-routine "breakpoint_remove" sb!c-call:void
-  (code-obj sb!c-call:unsigned-long)
-  (pc-offset sb!c-call:int)
-  (old-inst sb!c-call:unsigned-long))
+(sb!alien:define-alien-routine "breakpoint_remove" sb!alien:void
+  (code-obj sb!alien:unsigned-long)
+  (pc-offset sb!alien:int)
+  (old-inst sb!alien:unsigned-long))
 
-(sb!alien:define-alien-routine "breakpoint_do_displaced_inst" sb!c-call:void
+(sb!alien:define-alien-routine "breakpoint_do_displaced_inst" sb!alien:void
   (scp (* os-context-t))
-  (orig-inst sb!c-call:unsigned-long))
+  (orig-inst sb!alien:unsigned-long))
 
 ;;;; breakpoint handlers (layer between C and exported interface)
 
 ;;; breakpoints.
 (defun handle-breakpoint-aux (breakpoints data offset component signal-context)
   (unless breakpoints
-    (error "internal error: breakpoint that nobody wants"))
+    (bug "breakpoint that nobody wants"))
   (unless (member data *executing-breakpoint-hooks*)
     (let ((*executing-breakpoint-hooks* (cons data
                                              *executing-breakpoint-hooks*)))
       (breakpoint-do-displaced-inst signal-context
                                    (breakpoint-data-instruction data))
       ;; 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)
+      ;; implementation of arch_do_displaced_inst() _does_ sigreturn(),
+      ;; it's polite to warn here
+      #!+(and sparc solaris)
       (error "BREAKPOINT-DO-DISPLACED-INST returned?"))))
 
 (defun invoke-breakpoint-hooks (breakpoints component offset)
         (frame (do ((f (top-frame) (frame-down f)))
                    ((eq debug-fun (frame-debug-fun f)) f))))
     (dolist (bpt breakpoints)
-      (funcall (breakpoint-hook-function bpt)
+      (funcall (breakpoint-hook-fun bpt)
               frame
               ;; If this is an :UNKNOWN-RETURN-PARTNER, then pass the
               ;; hook function the original breakpoint, so that users
         (cookie (gethash component *fun-end-cookies*)))
     (remhash component *fun-end-cookies*)
     (dolist (bpt breakpoints)
-      (funcall (breakpoint-hook-function bpt)
+      (funcall (breakpoint-hook-fun bpt)
               frame bpt
               (get-fun-end-breakpoint-values scp)
               cookie))))
 (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)))
+                       #!-(or x86 x86-64) sb!vm::ocfp-offset
+                       #!+(or x86 x86-64) 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*)
 ;;;; MAKE-BOGUS-LRA (used for :FUN-END breakpoints)
 
 (defconstant bogus-lra-constants
-  #!-x86 2 #!+x86 3)
+  #!-(or x86 x86-64) 2 #!+(or x86 x86-64) 3)
 (defconstant known-return-p-slot
-  (+ sb!vm:code-constants-offset #!-x86 1 #!+x86 2))
+  (+ sb!vm:code-constants-offset #!-(or x86 x86-64) 1 #!+(or x86 x86-64) 2))
 
 ;;; Make a bogus LRA object that signals a breakpoint trap when
 ;;; returned to. If the breakpoint trap handler returns, REAL-LRA is
 ;;; instruction.
 (defun make-bogus-lra (real-lra &optional known-return-p)
   (without-gcing
+   ;; These are really code labels, not variables: but this way we get
+   ;; their addresses.
    (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
-           #!-(and x86 gencgc) sb!c:allocate-code-object
-           #!+(and x86 gencgc) sb!c::allocate-dynamic-code-object
-           (1+ bogus-lra-constants)
-           length))
+          (%primitive sb!c:allocate-code-object (1+ bogus-lra-constants)
+                      length))
          (dst-start (code-instructions code-object)))
      (declare (type system-area-pointer
                    src-start src-end dst-start trap-loc)
      (setf (%code-debug-info code-object) :bogus-lra)
      (setf (code-header-ref code-object sb!vm:code-trace-table-offset-slot)
           length)
-     #!-x86
+     #!-(or x86 x86-64)
      (setf (code-header-ref code-object real-lra-slot) real-lra)
-     #!+x86
+     #!+(or x86 x86-64)
      (multiple-value-bind (offset code) (compute-lra-data-from-pc real-lra)
        (setf (code-header-ref code-object real-lra-slot) code)
        (setf (code-header-ref code-object (1+ real-lra-slot)) offset))
           known-return-p)
      (system-area-copy src-start 0 dst-start 0 (* length sb!vm:n-byte-bits))
      (sb!vm:sanctify-for-execution code-object)
-     #!+x86
+     #!+(or x86 x86-64)
      (values dst-start code-object (sap- trap-loc src-start))
-     #!-x86
+     #!-(or x86 x86-64)
      (let ((new-lra (make-lisp-obj (+ (sap-int dst-start)
                                      sb!vm:other-pointer-lowtag))))
        (set-header-data
     ;; (There used to be more cases back before sbcl-0.7.0, when
     ;; we did special tricks to debug the IR1 interpreter.)
     ))
-
-(defun print-code-locations (function)
-  (let ((debug-fun (fun-debug-fun function)))
-    (do-debug-fun-blocks (block debug-fun)
-      (do-debug-block-locations (loc block)
-       (fill-in-code-location loc)
-       (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)
-       (terpri)))))