X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=inline;f=src%2Fcode%2Fdebug-int.lisp;h=e5dfe624c4f62b7c326163892db8fbcd22380bd7;hb=9abfd1a2b22862570c15ffa5129b1196d0480290;hp=c7a07a4706828b9b462691ce0cc3778a1d6c9496;hpb=65cccbb44b03207ce2fb73b29424a91a7d315189;p=sbcl.git

diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index c7a07a4..e5dfe62 100644
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -298,17 +298,21 @@
 ;;; This maps SB!C::COMPILED-DEBUG-FUNs to
 ;;; COMPILED-DEBUG-FUNs, so we can get at cached stuff and not
 ;;; duplicate COMPILED-DEBUG-FUN structures.
-(defvar *compiled-debug-funs* (make-hash-table :test 'eq))
+(defvar *compiled-debug-funs* (make-hash-table :test 'eq :weakness :key))
 
-;;; Make a COMPILED-DEBUG-FUN for a SB!C::COMPILER-DEBUG-FUN
-;;; and its component. This maps the latter to the former in
-;;; *COMPILED-DEBUG-FUNS*. If there already is a
-;;; COMPILED-DEBUG-FUN, then this returns it from
-;;; *COMPILED-DEBUG-FUNS*.
+;;; Make a COMPILED-DEBUG-FUN for a SB!C::COMPILER-DEBUG-FUN and its
+;;; component. This maps the latter to the former in
+;;; *COMPILED-DEBUG-FUNS*. If there already is a COMPILED-DEBUG-FUN,
+;;; then this returns it from *COMPILED-DEBUG-FUNS*.
+;;;
+;;; FIXME: It seems this table can potentially grow without bounds,
+;;; and retains roots to functions that might otherwise be collected.
 (defun make-compiled-debug-fun (compiler-debug-fun component)
-  (or (gethash compiler-debug-fun *compiled-debug-funs*)
-      (setf (gethash compiler-debug-fun *compiled-debug-funs*)
-            (%make-compiled-debug-fun compiler-debug-fun component))))
+  (let ((table *compiled-debug-funs*))
+    (with-locked-hash-table (table)
+      (or (gethash compiler-debug-fun table)
+          (setf (gethash compiler-debug-fun table)
+                (%make-compiled-debug-fun compiler-debug-fun component))))))
 
 (defstruct (bogus-debug-fun
             (:include debug-fun)
@@ -320,8 +324,6 @@
                                  (%function nil)))
             (:copier nil))
   %name)
-
-(defvar *ir1-lambda-debug-fun* (make-hash-table :test 'eq))
 
 ;;;; DEBUG-BLOCKs
 
@@ -356,8 +358,6 @@
                                  (:copier nil))
   ;; code-location information for the block
   (code-locations nil :type simple-vector))
-
-(defvar *ir1-block-debug-block* (make-hash-table :test 'eq))
 
 ;;;; breakpoints
 
@@ -662,8 +662,9 @@
 ;;; this function.
 (defun top-frame ()
   (/noshow0 "entering TOP-FRAME")
-  (multiple-value-bind (fp pc) (%caller-frame-and-pc)
-    (compute-calling-frame (descriptor-sap fp) pc nil)))
+  (compute-calling-frame (descriptor-sap (%caller-frame))
+                         (%caller-pc)
+                         nil))
 
 ;;; Flush all of the frames above FRAME, and renumber all the frames
 ;;; below FRAME.
@@ -674,6 +675,13 @@
       ((not (frame-p frame)))
     (setf (frame-number frame) number)))
 
+(defun find-saved-frame-down (fp up-frame)
+  (multiple-value-bind (saved-fp saved-pc) (sb!c:find-saved-fp-and-pc fp)
+    (when saved-fp
+      (compute-calling-frame (descriptor-sap saved-fp)
+                             (descriptor-sap saved-pc)
+                             up-frame))))
+
 ;;; Return the frame immediately below FRAME on the stack; or when
 ;;; FRAME is the bottom of the stack, return NIL.
 (defun frame-down (frame)
@@ -703,8 +711,9 @@
                      (when (control-stack-pointer-valid-p fp)
                        #!+(or x86 x86-64)
                        (multiple-value-bind (ok ra ofp) (x86-call-context fp)
-                         (and ok
-                              (compute-calling-frame ofp ra frame)))
+                         (if ok
+                             (compute-calling-frame ofp ra frame)
+                             (find-saved-frame-down fp frame)))
                        #!-(or x86 x86-64)
                        (compute-calling-frame
                         #!-alpha
@@ -780,7 +789,9 @@
 #!-(or x86 x86-64)
 (defun compute-calling-frame (caller lra up-frame)
   (declare (type system-area-pointer caller))
+  (/noshow0 "entering COMPUTE-CALLING-FRAME")
   (when (control-stack-pointer-valid-p caller)
+    (/noshow0 "in WHEN")
     (multiple-value-bind (code pc-offset escaped)
         (if lra
             (multiple-value-bind (word-offset code)
@@ -816,6 +827,7 @@
                            "bogus stack frame"))
                          (t
                           (debug-fun-from-pc code pc-offset)))))
+            (/noshow0 "returning MAKE-COMPILED-FRAME from COMPUTE-CALLING-FRAME")
             (make-compiled-frame caller up-frame d-fun
                                  (code-location-from-pc d-fun pc-offset
                                                         escaped)
@@ -869,7 +881,9 @@
   (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))
+                       (+ sb!vm::thread-interrupt-contexts-offset
+                          #!-alpha n
+                          #!+alpha (* 2 n)))
                       (* os-context-t)))
 
 #!+(or x86 x86-64)
@@ -915,13 +929,18 @@
 #!-(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))
+      (/noshow0 "at head of WITH-ALIEN")
     (let ((scp (nth-interrupt-context index)))
+        (/noshow0 "got SCP")
       (when (= (sap-int frame-pointer)
                (sb!vm:context-register scp sb!vm::cfp-offset))
         (without-gcing
+         (/noshow0 "in WITHOUT-GCING")
          (let ((code (code-object-from-bits
                       (sb!vm:context-register scp sb!vm::code-offset))))
+           (/noshow0 "got CODE")
            (when (symbolp code)
              (return (values code 0 scp)))
            (let* ((code-header-len (* (get-header-data code)
@@ -958,6 +977,7 @@
                      ;; pc-offset to 0 to keep the backtrace from
                      ;; exploding.
                      (setf pc-offset 0)))))
+             (/noshow0 "returning from FIND-ESCAPED-FRAME")
              (return
                (if (eq (%code-debug-info code) :bogus-lra)
                    (let ((real-lra (code-header-ref code
@@ -2014,19 +2034,19 @@ register."
        ;; pointer
        #!+(or x86 x86-64)
        (not (zerop (valid-lisp-pointer-p (int-sap val))))
-      ;; FIXME: There is no fundamental reason not to use the above
-      ;; function on other platforms as well, but I didn't have
-      ;; others available while doing this. --NS 2007-06-21
-      #!-(or x86 x86-64)
-      (and (logbitp 0 val)
-           (or (< sb!vm:read-only-space-start val
-                  (* sb!vm:*read-only-space-free-pointer*
-                     sb!vm:n-word-bytes))
-               (< sb!vm:static-space-start val
-                  (* sb!vm:*static-space-free-pointer*
-                     sb!vm:n-word-bytes))
-               (< (current-dynamic-space-start) val
-                  (sap-int (dynamic-space-free-pointer))))))
+       ;; FIXME: There is no fundamental reason not to use the above
+       ;; function on other platforms as well, but I didn't have
+       ;; others available while doing this. --NS 2007-06-21
+       #!-(or x86 x86-64)
+       (and (logbitp 0 val)
+            (or (< sb!vm:read-only-space-start val
+                   (* sb!vm:*read-only-space-free-pointer*
+                      sb!vm:n-word-bytes))
+                (< sb!vm:static-space-start val
+                   (* sb!vm:*static-space-free-pointer*
+                      sb!vm:n-word-bytes))
+                (< (current-dynamic-space-start) val
+                   (sap-int (dynamic-space-free-pointer))))))
       (values (%make-lisp-obj val) t)
       (if errorp
           (error "~S is not a valid argument to ~S"
@@ -2034,8 +2054,11 @@ register."
           (values (make-unprintable-object (format nil "invalid object #x~X" val))
                   nil))))
 
-#!-(or x86 x86-64)
 (defun sub-access-debug-var-slot (fp sc-offset &optional escaped)
+  ;; NOTE: The long-float support in here is obviously decayed.  When
+  ;; the x86oid and non-x86oid versions of this function were unified,
+  ;; the behavior of long-floats was preserved, which only served to
+  ;; highlight its brokenness.
   (macrolet ((with-escaped-value ((var) &body forms)
                `(if escaped
                     (let ((,var (sb!vm:context-register
@@ -2050,7 +2073,21 @@ register."
                      (sb!c:sc-offset-offset sc-offset)
                      ',format)
                     :invalid-value-for-unescaped-register-storage))
+             (escaped-complex-float-value (format offset)
+               `(if escaped
+                    (complex
+                     (sb!vm:context-float-register
+                      escaped (sb!c:sc-offset-offset sc-offset) ',format)
+                     (sb!vm:context-float-register
+                      escaped (+ (sb!c:sc-offset-offset sc-offset) ,offset) ',format))
+                    :invalid-value-for-unescaped-register-storage))
              (with-nfp ((var) &body body)
+               ;; x86oids have no separate number stack, so dummy it
+               ;; up for them.
+               #!+(or x86 x86-64)
+               `(let ((,var fp))
+                  ,@body)
+               #!-(or x86 x86-64)
                `(let ((,var (if escaped
                                 (sb!sys:int-sap
                                  (sb!vm:context-register escaped
@@ -2062,12 +2099,21 @@ register."
                                 (sb!vm::make-number-stack-pointer
                                  (sb!sys:sap-ref-32 fp (* nfp-save-offset
                                                           sb!vm:n-word-bytes))))))
-                  ,@body)))
+                  ,@body))
+             (stack-frame-offset (data-width offset)
+               #!+(or x86 x86-64)
+               `(- (* (+ (sb!c:sc-offset-offset sc-offset) ,data-width ,offset)
+                      sb!vm:n-word-bytes))
+               #!-(or x86 x86-64)
+               (declare (ignore data-width))
+               #!-(or x86 x86-64)
+               `(* (+ (sb!c:sc-offset-offset sc-offset) ,offset)
+                   sb!vm:n-word-bytes)))
     (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
+       (without-gcing
         (with-escaped-value (val)
           (make-lisp-obj val nil))))
       (#.sb!vm:character-reg-sc-number
@@ -2084,8 +2130,10 @@ register."
       (#.sb!vm:unsigned-reg-sc-number
        (with-escaped-value (val)
          val))
+      #!-(or x86 x86-64)
       (#.sb!vm:non-descriptor-reg-sc-number
        (error "Local non-descriptor register access?"))
+      #!-(or x86 x86-64)
       (#.sb!vm:interior-reg-sc-number
        (error "Local interior register access?"))
       (#.sb!vm:single-reg-sc-number
@@ -2096,187 +2144,57 @@ register."
       (#.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))
+       (escaped-complex-float-value single-float 1))
       (#.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))
+       (escaped-complex-float-value double-float #!+sparc 2 #!-sparc 1))
       #!+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))
+       (escaped-complex-float-value long-float
+                                    #!+sparc 4 #!+(or x86 x86-64) 1
+                                    #!-(or sparc x86 x86-64) 0))
       (#.sb!vm:single-stack-sc-number
        (with-nfp (nfp)
-         (sb!sys:sap-ref-single nfp (* (sb!c:sc-offset-offset sc-offset)
-                                       sb!vm:n-word-bytes))))
+         (sb!sys:sap-ref-single nfp (stack-frame-offset 1 0))))
       (#.sb!vm:double-stack-sc-number
        (with-nfp (nfp)
-         (sb!sys:sap-ref-double nfp (* (sb!c:sc-offset-offset sc-offset)
-                                       sb!vm:n-word-bytes))))
+         (sb!sys:sap-ref-double nfp (stack-frame-offset 2 0))))
       #!+long-float
       (#.sb!vm:long-stack-sc-number
        (with-nfp (nfp)
-         (sb!sys:sap-ref-long nfp (* (sb!c:sc-offset-offset sc-offset)
-                                     sb!vm:n-word-bytes))))
+         (sb!sys:sap-ref-long nfp (stack-frame-offset 3 0))))
       (#.sb!vm:complex-single-stack-sc-number
        (with-nfp (nfp)
          (complex
-          (sb!sys:sap-ref-single nfp (* (sb!c:sc-offset-offset sc-offset)
-                                        sb!vm:n-word-bytes))
-          (sb!sys:sap-ref-single nfp (* (1+ (sb!c:sc-offset-offset sc-offset))
-                                        sb!vm:n-word-bytes)))))
+          (sb!sys:sap-ref-single nfp (stack-frame-offset 1 0))
+          (sb!sys:sap-ref-single nfp (stack-frame-offset 1 1)))))
       (#.sb!vm:complex-double-stack-sc-number
        (with-nfp (nfp)
          (complex
-          (sb!sys:sap-ref-double nfp (* (sb!c:sc-offset-offset sc-offset)
-                                        sb!vm:n-word-bytes))
-          (sb!sys:sap-ref-double nfp (* (+ (sb!c:sc-offset-offset sc-offset) 2)
-                                        sb!vm:n-word-bytes)))))
+          (sb!sys:sap-ref-double nfp (stack-frame-offset 2 0))
+          (sb!sys:sap-ref-double nfp (stack-frame-offset 2 2)))))
       #!+long-float
       (#.sb!vm:complex-long-stack-sc-number
        (with-nfp (nfp)
          (complex
-          (sb!sys:sap-ref-long nfp (* (sb!c:sc-offset-offset sc-offset)
-                                      sb!vm:n-word-bytes))
-          (sb!sys:sap-ref-long nfp (* (+ (sb!c:sc-offset-offset sc-offset)
-                                         #!+sparc 4)
-                                      sb!vm:n-word-bytes)))))
+          (sb!sys:sap-ref-long nfp (stack-frame-offset 3 0))
+          (sb!sys:sap-ref-long nfp
+                               (stack-frame-offset 3 #!+sparc 4
+                                                   #!+(or x86 x86-64) 3
+                                                   #!-(or sparc x86 x86-64) 0)))))
       (#.sb!vm:control-stack-sc-number
-       (sb!kernel:stack-ref fp (sb!c:sc-offset-offset sc-offset)))
+       (stack-ref fp (sb!c:sc-offset-offset sc-offset)))
       (#.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)))))
+         (code-char (sb!sys:sap-ref-word nfp (stack-frame-offset 1 0)))))
       (#.sb!vm:unsigned-stack-sc-number
        (with-nfp (nfp)
-         (sb!sys:sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset)
-                                   sb!vm:n-word-bytes))))
+         (sb!sys:sap-ref-word nfp (stack-frame-offset 1 0))))
       (#.sb!vm:signed-stack-sc-number
        (with-nfp (nfp)
-         (sb!sys:signed-sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset)
-                                          sb!vm:n-word-bytes))))
+         (sb!sys:signed-sap-ref-word nfp (stack-frame-offset 1 0))))
       (#.sb!vm:sap-stack-sc-number
        (with-nfp (nfp)
-         (sb!sys:sap-ref-sap nfp (* (sb!c:sc-offset-offset sc-offset)
-                                    sb!vm:n-word-bytes)))))))
-
-#!+(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)
-               `(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))
-             (escaped-complex-float-value (format)
-               `(if escaped
-                    (complex
-                     (sb!vm:context-float-register
-                      escaped (sb!c:sc-offset-offset sc-offset) ',format)
-                     (sb!vm:context-float-register
-                      escaped (1+ (sb!c:sc-offset-offset sc-offset)) ',format))
-                    :invalid-value-for-unescaped-register-storage)))
-    (ecase (sb!c:sc-offset-scn sc-offset)
-      ((#.sb!vm:any-reg-sc-number #.sb!vm:descriptor-reg-sc-number)
-       (without-gcing
-        (with-escaped-value (val)
-          (make-lisp-obj val nil))))
-      (#.sb!vm:character-reg-sc-number
-       (with-escaped-value (val)
-         (code-char val)))
-      (#.sb!vm:sap-reg-sc-number
-       (with-escaped-value (val)
-         (int-sap val)))
-      (#.sb!vm:signed-reg-sc-number
-       (with-escaped-value (val)
-         (if (logbitp (1- sb!vm:n-word-bits) val)
-             (logior val (ash -1 sb!vm:n-word-bits))
-             val)))
-      (#.sb!vm:unsigned-reg-sc-number
-       (with-escaped-value (val)
-         val))
-      (#.sb!vm: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
-       (escaped-complex-float-value single-float))
-      (#.sb!vm:complex-double-reg-sc-number
-       (escaped-complex-float-value double-float))
-      #!+long-float
-      (#.sb!vm:complex-long-reg-sc-number
-       (escaped-complex-float-value long-float))
-      (#.sb!vm:single-stack-sc-number
-       (sap-ref-single fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
-                                sb!vm:n-word-bytes))))
-      (#.sb!vm:double-stack-sc-number
-       (sap-ref-double fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2)
-                                sb!vm:n-word-bytes))))
-      #!+long-float
-      (#.sb!vm:long-stack-sc-number
-       (sap-ref-long fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 3)
-                              sb!vm:n-word-bytes))))
-      (#.sb!vm:complex-single-stack-sc-number
-       (complex
-        (sap-ref-single fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
-                                 sb!vm:n-word-bytes)))
-        (sap-ref-single fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2)
-                                 sb!vm:n-word-bytes)))))
-      (#.sb!vm:complex-double-stack-sc-number
-       (complex
-        (sap-ref-double fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2)
-                                 sb!vm:n-word-bytes)))
-        (sap-ref-double fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 4)
-                                 sb!vm:n-word-bytes)))))
-      #!+long-float
-      (#.sb!vm:complex-long-stack-sc-number
-       (complex
-        (sap-ref-long fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 3)
-                               sb!vm:n-word-bytes)))
-        (sap-ref-long fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 6)
-                               sb!vm:n-word-bytes)))))
-      (#.sb!vm:control-stack-sc-number
-       (stack-ref fp (sb!c:sc-offset-offset sc-offset)))
-      (#.sb!vm:character-stack-sc-number
-       (code-char
-        (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-word fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
-                              sb!vm:n-word-bytes))))
-      (#.sb!vm:signed-stack-sc-number
-       (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)))))))
+         (sb!sys:sap-ref-sap nfp (stack-frame-offset 1 0)))))))
 
 ;;; This stores value as the value of DEBUG-VAR in FRAME. In the
 ;;; COMPILED-DEBUG-VAR case, access the current value to determine if
@@ -2306,8 +2224,22 @@ register."
              (compiled-debug-var-sc-offset debug-var))
          value))))
 
-#!-(or x86 x86-64)
 (defun sub-set-debug-var-slot (fp sc-offset value &optional escaped)
+  ;; Like sub-access-debug-var-slot, this is the unification of two
+  ;; divergent copy-pasted functions.  The astute reviewer will notice
+  ;; that long-floats are messed up here as well, that x86oids
+  ;; apparently don't support accessing float values that are in
+  ;; registers, and that non-x86oids store the real part of a float
+  ;; for both the real and imaginary parts of a complex on the stack
+  ;; (but not in registers, oddly enough).  Some research has
+  ;; indicated that the different forms of THE used for validating the
+  ;; type of complex float components between x86oid and non-x86oid
+  ;; systems are only significant in the case of using a non-complex
+  ;; number as input (as the non-x86oid case effectively converts
+  ;; non-complex numbers to complex ones and the x86oid case will
+  ;; error out).  That said, the error message from entering a value
+  ;; of the wrong type will be slightly easier to understand on x86oid
+  ;; systems.
   (macrolet ((set-escaped-value (val)
                `(if escaped
                     (setf (sb!vm:context-register
@@ -2323,7 +2255,24 @@ register."
                            ',format)
                           ,val)
                     value))
+             (set-escaped-complex-float-value (format offset val)
+               `(progn
+                  (when escaped
+                    (setf (sb!vm:context-float-register
+                           escaped (sb!c:sc-offset-offset sc-offset) ',format)
+                          (realpart value))
+                    (setf (sb!vm:context-float-register
+                           escaped (+ (sb!c:sc-offset-offset sc-offset) ,offset)
+                           ',format)
+                          (imagpart value)))
+                  ,val))
              (with-nfp ((var) &body body)
+               ;; x86oids have no separate number stack, so dummy it
+               ;; up for them.
+               #!+(or x86 x86-64)
+               `(let ((,var fp))
+                  ,@body)
+               #!-(or x86 x86-64)
                `(let ((,var (if escaped
                                 (int-sap
                                  (sb!vm:context-register escaped
@@ -2337,7 +2286,16 @@ register."
                                  (sap-ref-32 fp
                                              (* nfp-save-offset
                                                 sb!vm:n-word-bytes))))))
-                  ,@body)))
+                  ,@body))
+             (stack-frame-offset (data-width offset)
+               #!+(or x86 x86-64)
+               `(- (* (+ (sb!c:sc-offset-offset sc-offset) ,data-width ,offset)
+                      sb!vm:n-word-bytes))
+               #!-(or x86 x86-64)
+               (declare (ignore data-width))
+               #!-(or x86 x86-64)
+               `(* (+ (sb!c:sc-offset-offset sc-offset) ,offset)
+                   sb!vm:n-word-bytes)))
     (ecase (sb!c:sc-offset-scn sc-offset)
       ((#.sb!vm:any-reg-sc-number
         #.sb!vm:descriptor-reg-sc-number
@@ -2353,214 +2311,108 @@ register."
        (set-escaped-value (logand value (1- (ash 1 sb!vm:n-word-bits)))))
       (#.sb!vm:unsigned-reg-sc-number
        (set-escaped-value value))
+      #!-(or x86 x86-64)
       (#.sb!vm:non-descriptor-reg-sc-number
        (error "Local non-descriptor register access?"))
+      #!-(or x86 x86-64)
       (#.sb!vm:interior-reg-sc-number
        (error "Local interior register access?"))
       (#.sb!vm:single-reg-sc-number
+       #!-(or x86 x86-64) ;; don't have escaped floats.
        (set-escaped-float-value single-float value))
       (#.sb!vm:double-reg-sc-number
+       #!-(or x86 x86-64) ;; don't have escaped floats -- still in npx?
        (set-escaped-float-value double-float value))
       #!+long-float
       (#.sb!vm:long-reg-sc-number
+       #!-(or x86 x86-64) ;; don't have escaped floats -- still in npx?
        (set-escaped-float-value long-float value))
+      #!-(or x86 x86-64)
       (#.sb!vm:complex-single-reg-sc-number
-       (when escaped
-         (setf (sb!vm:context-float-register escaped
-                                             (sb!c:sc-offset-offset sc-offset)
-                                             'single-float)
-               (realpart value))
-         (setf (sb!vm:context-float-register
-                escaped (1+ (sb!c:sc-offset-offset sc-offset))
-                'single-float)
-               (imagpart value)))
-       value)
+       (set-escaped-complex-float-value single-float 1 value))
+      #!-(or x86 x86-64)
       (#.sb!vm:complex-double-reg-sc-number
-       (when escaped
-         (setf (sb!vm:context-float-register
-                escaped (sb!c:sc-offset-offset sc-offset) 'double-float)
-               (realpart value))
-         (setf (sb!vm:context-float-register
-                escaped
-                (+ (sb!c:sc-offset-offset sc-offset) #!+sparc 2 #!-sparc 1)
-                'double-float)
-               (imagpart value)))
-       value)
-      #!+long-float
+       (set-escaped-complex-float-value double-float #!+sparc 2 #!-sparc 1 value))
+      #!+(and long-float (not (or x86 x86-64)))
       (#.sb!vm:complex-long-reg-sc-number
-       (when escaped
-         (setf (sb!vm:context-float-register
-                escaped (sb!c:sc-offset-offset sc-offset) 'long-float)
-               (realpart value))
-         (setf (sb!vm:context-float-register
-                escaped
-                (+ (sb!c:sc-offset-offset sc-offset) #!+sparc 4)
-                'long-float)
-               (imagpart value)))
-       value)
+       (set-escaped-complex-float-value long-float #!+sparc 4 #!-sparc 0 value))
       (#.sb!vm:single-stack-sc-number
        (with-nfp (nfp)
-         (setf (sap-ref-single nfp (* (sb!c:sc-offset-offset sc-offset)
-                                      sb!vm:n-word-bytes))
+         (setf (sap-ref-single nfp (stack-frame-offset 1 0))
                (the single-float value))))
       (#.sb!vm:double-stack-sc-number
        (with-nfp (nfp)
-         (setf (sap-ref-double nfp (* (sb!c:sc-offset-offset sc-offset)
-                                      sb!vm:n-word-bytes))
+         (setf (sap-ref-double nfp (stack-frame-offset 2 0))
                (the double-float value))))
       #!+long-float
       (#.sb!vm:long-stack-sc-number
        (with-nfp (nfp)
-         (setf (sap-ref-long nfp (* (sb!c:sc-offset-offset sc-offset)
-                                    sb!vm:n-word-bytes))
+         (setf (sap-ref-long nfp (stack-frame-offset 3 0))
                (the long-float value))))
       (#.sb!vm:complex-single-stack-sc-number
        (with-nfp (nfp)
          (setf (sap-ref-single
-                nfp (* (sb!c:sc-offset-offset sc-offset) sb!vm:n-word-bytes))
+                nfp (stack-frame-offset 1 0))
+               #!+(or x86 x86-64)
+               (realpart (the (complex single-float) value))
+               #!-(or x86 x86-64)
                (the single-float (realpart value)))
          (setf (sap-ref-single
-                nfp (* (1+ (sb!c:sc-offset-offset sc-offset))
-                       sb!vm:n-word-bytes))
+                nfp (stack-frame-offset 1 1))
+               #!+(or x86 x86-64)
+               (imagpart (the (complex single-float) value))
+               #!-(or x86 x86-64)
                (the single-float (realpart value)))))
       (#.sb!vm:complex-double-stack-sc-number
        (with-nfp (nfp)
          (setf (sap-ref-double
-                nfp (* (sb!c:sc-offset-offset sc-offset) sb!vm:n-word-bytes))
+                nfp (stack-frame-offset 2 0))
+               #!+(or x86 x86-64)
+               (realpart (the (complex double-float) value))
+               #!-(or x86 x86-64)
                (the double-float (realpart value)))
          (setf (sap-ref-double
-                nfp (* (+ (sb!c:sc-offset-offset sc-offset) 2)
-                       sb!vm:n-word-bytes))
+                nfp (stack-frame-offset 2 2))
+               #!+(or x86 x86-64)
+               (imagpart (the (complex double-float) value))
+               #!-(or x86 x86-64)
                (the double-float (realpart value)))))
       #!+long-float
       (#.sb!vm:complex-long-stack-sc-number
        (with-nfp (nfp)
          (setf (sap-ref-long
-                nfp (* (sb!c:sc-offset-offset sc-offset) sb!vm:n-word-bytes))
+                nfp (stack-frame-offset 3 0))
+               #!+(or x86 x86-64)
+               (realpart (the (complex long-float) value))
+               #!-(or x86 x86-64)
                (the long-float (realpart value)))
          (setf (sap-ref-long
-                nfp (* (+ (sb!c:sc-offset-offset sc-offset) #!+sparc 4)
-                       sb!vm:n-word-bytes))
+                nfp (stack-frame-offset 3 #!+sparc 4
+                                        #!+(or x86 x86-64) 3
+                                        #!-(or sparc x86 x86-64) 0))
+               #!+(or x86 x86-64)
+               (imagpart (the (complex long-float) value))
+               #!-(or x86 x86-64)
                (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:character-stack-sc-number
        (with-nfp (nfp)
-         (setf (sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset)
-                                         sb!vm:n-word-bytes))
+         (setf (sap-ref-word nfp (stack-frame-offset 1 0))
                (char-code (the character value)))))
       (#.sb!vm:unsigned-stack-sc-number
        (with-nfp (nfp)
-         (setf (sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset)
-                                  sb!vm:n-word-bytes))
+         (setf (sap-ref-word nfp (stack-frame-offset 1 0))
                (the (unsigned-byte 32) value))))
       (#.sb!vm:signed-stack-sc-number
        (with-nfp (nfp)
-         (setf (signed-sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset)
-                                         sb!vm:n-word-bytes))
+         (setf (signed-sap-ref-word nfp (stack-frame-offset 1 0))
                (the (signed-byte 32) value))))
       (#.sb!vm:sap-stack-sc-number
        (with-nfp (nfp)
-         (setf (sap-ref-sap nfp (* (sb!c:sc-offset-offset sc-offset)
-                                   sb!vm:n-word-bytes))
+         (setf (sap-ref-sap nfp (stack-frame-offset 1 0))
                (the system-area-pointer value)))))))
 
-#!+(or x86 x86-64)
-(defun sub-set-debug-var-slot (fp sc-offset value &optional escaped)
-  (macrolet ((set-escaped-value (val)
-               `(if escaped
-                    (setf (sb!vm:context-register
-                           escaped
-                           (sb!c:sc-offset-offset sc-offset))
-                          ,val)
-                    value)))
-    (ecase (sb!c:sc-offset-scn sc-offset)
-      ((#.sb!vm:any-reg-sc-number #.sb!vm:descriptor-reg-sc-number)
-       (without-gcing
-        (set-escaped-value
-          (get-lisp-obj-address value))))
-      (#.sb!vm:character-reg-sc-number
-       (set-escaped-value (char-code value)))
-      (#.sb!vm:sap-reg-sc-number
-       (set-escaped-value (sap-int value)))
-      (#.sb!vm:signed-reg-sc-number
-       (set-escaped-value (logand value (1- (ash 1 sb!vm:n-word-bits)))))
-      (#.sb!vm:unsigned-reg-sc-number
-       (set-escaped-value value))
-      (#.sb!vm:single-reg-sc-number
-        #+nil ;; don't have escaped floats.
-       (set-escaped-float-value single-float value))
-      (#.sb!vm:double-reg-sc-number
-        #+nil ;;  don't have escaped floats -- still in npx?
-       (set-escaped-float-value double-float value))
-      #!+long-float
-      (#.sb!vm:long-reg-sc-number
-        #+nil ;;  don't have escaped floats -- still in npx?
-       (set-escaped-float-value long-float value))
-      (#.sb!vm:single-stack-sc-number
-       (setf (sap-ref-single
-              fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
-                       sb!vm:n-word-bytes)))
-             (the single-float value)))
-      (#.sb!vm:double-stack-sc-number
-       (setf (sap-ref-double
-              fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2)
-                       sb!vm:n-word-bytes)))
-             (the double-float value)))
-      #!+long-float
-      (#.sb!vm:long-stack-sc-number
-       (setf (sap-ref-long
-              fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 3)
-                       sb!vm:n-word-bytes)))
-             (the long-float value)))
-      (#.sb!vm:complex-single-stack-sc-number
-       (setf (sap-ref-single
-              fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
-                       sb!vm:n-word-bytes)))
-             (realpart (the (complex single-float) value)))
-       (setf (sap-ref-single
-              fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2)
-                       sb!vm:n-word-bytes)))
-             (imagpart (the (complex single-float) value))))
-      (#.sb!vm:complex-double-stack-sc-number
-       (setf (sap-ref-double
-              fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2)
-                       sb!vm:n-word-bytes)))
-             (realpart (the (complex double-float) value)))
-       (setf (sap-ref-double
-              fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 4)
-                       sb!vm:n-word-bytes)))
-             (imagpart (the (complex double-float) value))))
-      #!+long-float
-      (#.sb!vm:complex-long-stack-sc-number
-       (setf (sap-ref-long
-              fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 3)
-                       sb!vm:n-word-bytes)))
-             (realpart (the (complex long-float) value)))
-       (setf (sap-ref-long
-              fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 6)
-                       sb!vm:n-word-bytes)))
-             (imagpart (the (complex long-float) value))))
-      (#.sb!vm:control-stack-sc-number
-       (setf (stack-ref fp (sb!c:sc-offset-offset sc-offset)) value))
-      (#.sb!vm: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-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-word
-              fp (- (* (1+ (sb!c:sc-offset-offset sc-offset))
-                       sb!vm:n-word-bytes)))
-             (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)))
-             (the system-area-pointer value))))))
-
 ;;; The method for setting and accessing COMPILED-DEBUG-VAR values use
 ;;; this to determine if the value stored is the actual value or an
 ;;; indirection cell.
@@ -2634,13 +2486,6 @@ register."
 ;;; 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
-(defvar *form-number-temp* (make-array 10 :fill-pointer 0 :adjustable t))
-
-;;; table used to detect CAR circularities in FORM-NUMBER-TRANSLATIONS
-(defvar *form-number-circularity-table* (make-hash-table :test 'eq))
-
 ;;; This returns a table mapping form numbers to source-paths. A
 ;;; source-path indicates a descent into the TOPLEVEL-FORM form,
 ;;; going directly to the subform corressponding to the form number.
@@ -2649,32 +2494,32 @@ register."
 ;;; NODE-SOURCE-PATH; that is, the first element is the form number and
 ;;; the last is the TOPLEVEL-FORM number.
 (defun form-number-translations (form tlf-number)
-  (clrhash *form-number-circularity-table*)
-  (setf (fill-pointer *form-number-temp*) 0)
-  (sub-translate-form-numbers form (list tlf-number))
-  (coerce *form-number-temp* 'simple-vector))
-(defun sub-translate-form-numbers (form path)
-  (unless (gethash form *form-number-circularity-table*)
-    (setf (gethash form *form-number-circularity-table*) t)
-    (vector-push-extend (cons (fill-pointer *form-number-temp*) path)
-                        *form-number-temp*)
-    (let ((pos 0)
-          (subform form)
-          (trail form))
-      (declare (fixnum pos))
-      (macrolet ((frob ()
-                   '(progn
-                      (when (atom subform) (return))
-                      (let ((fm (car subform)))
-                        (when (consp fm)
-                          (sub-translate-form-numbers fm (cons pos path)))
-                        (incf pos))
-                      (setq subform (cdr subform))
-                      (when (eq subform trail) (return)))))
-        (loop
-          (frob)
-          (frob)
-          (setq trail (cdr trail)))))))
+  (let ((seen nil)
+        (translations (make-array 12 :fill-pointer 0 :adjustable t)))
+    (labels ((translate1 (form path)
+               (unless (member form seen)
+                 (push form seen)
+                 (vector-push-extend (cons (fill-pointer translations) path)
+                                     translations)
+                 (let ((pos 0)
+                       (subform form)
+                       (trail form))
+                   (declare (fixnum pos))
+                   (macrolet ((frob ()
+                                '(progn
+                                  (when (atom subform) (return))
+                                  (let ((fm (car subform)))
+                                    (when (consp fm)
+                                      (translate1 fm (cons pos path)))
+                                    (incf pos))
+                                  (setq subform (cdr subform))
+                                  (when (eq subform trail) (return)))))
+                     (loop
+                       (frob)
+                       (frob)
+                       (setq trail (cdr trail))))))))
+      (translate1 form (list tlf-number)))
+    (coerce translations 'simple-vector)))
 
 ;;; 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
@@ -2863,7 +2708,7 @@ register."
 ;;; This maps bogus-lra-components to cookies, so that
 ;;; HANDLE-FUN-END-BREAKPOINT can find the appropriate cookie for the
 ;;; breakpoint hook.
-(defvar *fun-end-cookies* (make-hash-table :test 'eq))
+(defvar *fun-end-cookies* (make-hash-table :test 'eq :synchronized t))
 
 ;;; This returns a hook function for the start helper breakpoint
 ;;; associated with a :FUN-END breakpoint. The returned function
@@ -3115,7 +2960,7 @@ register."
 ;;;; breakpoint handlers (layer between C and exported interface)
 
 ;;; This maps components to a mapping of offsets to BREAKPOINT-DATAs.
-(defvar *component-breakpoint-offsets* (make-hash-table :test 'eq))
+(defvar *component-breakpoint-offsets* (make-hash-table :test 'eq :synchronized t))
 
 ;;; This returns the BREAKPOINT-DATA object associated with component cross
 ;;; offset. If none exists, this makes one, installs it, and returns it.
@@ -3137,6 +2982,8 @@ register."
 ;;; We use this when there are no longer any active breakpoints
 ;;; corresponding to DATA.
 (defun delete-breakpoint-data (data)
+  ;; Again, this looks brittle. Is there no danger of being interrupted
+  ;; here?
   (let* ((component (breakpoint-data-component data))
          (offsets (delete (breakpoint-data-offset data)
                           (gethash component *component-breakpoint-offsets*)
@@ -3240,6 +3087,8 @@ register."
 ;;; [old C code] or HANDLE-FUN-END-BREAKPOINT calls this directly
 ;;; [new C code].
 (defun handle-fun-end-breakpoint-aux (breakpoints data signal-context)
+  ;; FIXME: This looks brittle: what if we are interrupted somewhere
+  ;; here? ...or do we have interrupts disabled here?
   (delete-breakpoint-data data)
   (let* ((scp
           (locally
@@ -3294,8 +3143,7 @@ register."
           (trap-loc (foreign-symbol-sap "fun_end_breakpoint_trap"))
           (length (sap- src-end src-start))
           (code-object
-           (%primitive sb!c:allocate-code-object (1+ bogus-lra-constants)
-                       length))
+           (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)
@@ -3378,9 +3226,9 @@ register."
     ;; sense in signaling the condition.
     (when step-info
       (let ((*step-frame*
-             #+(or x86 x86-64)
+             #!+(or x86 x86-64)
              (signal-context-frame (sb!alien::alien-sap context))
-             #-(or x86 x86-64)
+             #!-(or x86 x86-64)
              ;; KLUDGE: Use the first non-foreign frame as the
              ;; *STACK-TOP-HINT*. Getting the frame from the signal
              ;; context as on x86 would be cleaner, but