0.pre7.50:
[sbcl.git] / src / code / debug-int.lisp
index 23ad564..16eae71 100644 (file)
   (code-location nil :type code-location)
   ;; an a-list of catch-tags to code-locations
   (%catches :unparsed :type (or list (member :unparsed)))
-  ;; pointer to frame on control stack. (unexported) When this frame
-  ;; is an interpreted-frame, this pointer is an index into the
-  ;; interpreter's stack.
+  ;; pointer to frame on control stack (unexported)
   pointer
   ;; This is the frame's number for prompt printing. Top is zero.
   (number 0 :type index))
            (:include frame)
            (:constructor make-compiled-frame
                          (pointer up debug-function code-location number
-                                  #!+gengc saved-state-chain
                                   &optional escaped))
            (:copier nil))
   ;; This indicates whether someone interrupted the frame.
   ;; (unexported). If escaped, this is a pointer to the state that was
-  ;; saved when we were interrupted. On the non-gengc system, this is
-  ;; a pointer to an os_context_t, i.e. the third argument to an
-  ;; SA_SIGACTION-style signal handler. On the gengc system, this is a
-  ;; state pointer from SAVED-STATE-CHAIN.
-  escaped
-  ;; a list of SAPs to saved states. Each time we unwind past an
-  ;; exception, we pop the next entry off this list. When we get to
-  ;; the end of the list, there is nothing else on the stack.
-  #!+gengc (saved-state-chain nil :type list))
+  ;; saved when we were interrupted, an os_context_t, i.e. the third
+  ;; argument to an SA_SIGACTION-style signal handler.
+  escaped)
 (def!method print-object ((obj compiled-frame) str)
   (print-unreadable-object (obj str :type t)
     (format str
            "~S~:[~;, interrupted~]"
            (debug-function-name (frame-debug-function obj))
            (compiled-frame-escaped obj))))
-
-(defstruct (interpreted-frame
-           (:include frame)
-           (:constructor make-interpreted-frame
-                         (pointer up debug-function code-location number
-                          real-frame closure))
-           (:copier nil))
-  ;; This points to the compiled-frame for SB!BYTECODE:INTERNAL-APPLY-LOOP.
-  (real-frame nil :type compiled-frame)
-  ;; This is the closed over data used by the interpreter.
-  (closure nil :type simple-vector))
-(def!method print-object ((obj interpreted-frame) str)
-  (print-unreadable-object (obj str :type t)
-    (prin1 (debug-function-name (frame-debug-function obj)) str)))
 \f
 ;;;; DEBUG-FUNCTIONs
 
 
 #!+sb-doc
 (setf (fdocumentation 'debug-block-successors 'function)
-  "Returns the list of possible code-locations where execution may continue
+  "Return the list of possible code-locations where execution may continue
    when the basic-block represented by debug-block completes its execution.")
 
 #!+sb-doc
 (setf (fdocumentation 'debug-block-elsewhere-p 'function)
-  "Returns whether debug-block represents elsewhere code.")
+  "Return whether debug-block represents elsewhere code.")
 
 (defstruct (compiled-debug-block (:include debug-block)
                                 (:constructor
              (etypecase what
                (code-location nil)
                (debug-function (breakpoint-kind obj)))))))
-
-#!+sb-doc
-(setf (fdocumentation 'breakpoint-hook-function 'function)
-  "Returns the breakpoint's function the system calls when execution encounters
-   the breakpoint, and it is active. This is SETF'able.")
-
-#!+sb-doc
-(setf (fdocumentation 'breakpoint-what 'function)
-  "Returns the breakpoint's what specification.")
-
-#!+sb-doc
-(setf (fdocumentation 'breakpoint-kind 'function)
-  "Returns the breakpoint's kind specification.")
-
+\f
 ;;;; CODE-LOCATIONs
 
 (defstruct (code-location (:constructor nil)
     (prin1 (debug-function-name (code-location-debug-function obj))
           str)))
 
-#!+sb-doc
-(setf (fdocumentation 'code-location-debug-function 'function)
-  "Returns the debug-function representing information about the function
-   corresponding to the code-location.")
-
 (defstruct (compiled-code-location
            (:include code-location)
            (:constructor make-known-code-location
 (defun stack-ref (s n) (stack-ref s n))
 (defun %set-stack-ref (s n value) (%set-stack-ref s n value))
 (defun function-code-header (fun) (function-code-header fun))
-#!-gengc (defun lra-code-header (lra) (lra-code-header lra))
+(defun lra-code-header (lra) (lra-code-header lra))
 (defun make-lisp-obj (value) (make-lisp-obj value))
 (defun get-lisp-obj-address (thing) (get-lisp-obj-address thing))
 (defun function-word-offset (fun) (function-word-offset fun))
   (declare (type system-area-pointer x))
   #!-x86 ; stack grows toward high address values
   (and (sap< x (current-sp))
-       (sap<= #!-gengc (int-sap control-stack-start)
-             #!+gengc (mutator-control-stack-base)
+       (sap<= (int-sap control-stack-start)
              x)
        (zerop (logand (sap-int x) #b11)))
   #!+x86 ; stack grows toward low address values
        (sap> (int-sap control-stack-end) x)
        (zerop (logand (sap-int x) #b11))))
 
-#!+(or gengc x86)
+#!+x86
 (sb!alien:def-alien-routine component-ptr-from-pc (system-area-pointer)
   (pc system-area-pointer))
 
-#!+(or gengc x86)
+#!+x86
 (defun component-from-component-ptr (component-ptr)
   (declare (type system-area-pointer component-ptr))
   (make-lisp-obj (logior (sap-int component-ptr)
 ;;; Return the top frame of the control stack as it was before calling
 ;;; this function.
 (defun top-frame ()
+  (/show0 "entering TOP-FRAME")
   (multiple-value-bind (fp pc) (%caller-frame-and-pc)
-    (possibly-an-interpreted-frame
-     (compute-calling-frame (descriptor-sap fp)
-                           #!-gengc pc #!+gengc (descriptor-sap pc)
-                           nil)
-     nil)))
+    (compute-calling-frame (descriptor-sap fp) pc nil)))
 
 ;;; Flush all of the frames above FRAME, and renumber all the frames
 ;;; below FRAME.
 ;;; Return the frame immediately below FRAME on the stack; or when
 ;;; FRAME is the bottom of the stack, return NIL.
 (defun frame-down (frame)
+  (/show0 "entering FRAME-DOWN")
   ;; We have to access the old-fp and return-pc out of frame and pass
   ;; them to COMPUTE-CALLING-FRAME.
   (let ((down (frame-%down frame)))
     (if (eq down :unparsed)
-       (let* ((real (frame-real-frame frame))
-              (debug-fun (frame-debug-function real)))
+       (let ((debug-fun (frame-debug-function frame)))
+         (/show0 "in DOWN :UNPARSED case")
          (setf (frame-%down frame)
                (etypecase debug-fun
                  (compiled-debug-function
                   (let ((c-d-f (compiled-debug-function-compiler-debug-fun
                                 debug-fun)))
-                    (possibly-an-interpreted-frame
-                     (compute-calling-frame
-                      (descriptor-sap
-                       (get-context-value
-                        real sb!vm::ocfp-save-offset
-                        (sb!c::compiled-debug-function-old-fp c-d-f)))
-                      #!-gengc
+                    (compute-calling-frame
+                     (descriptor-sap
                       (get-context-value
-                       real sb!vm::lra-save-offset
-                       (sb!c::compiled-debug-function-return-pc c-d-f))
-                      #!+gengc
-                      (descriptor-sap
-                       (get-context-value
-                        real sb!vm::ra-save-offset
-                        (sb!c::compiled-debug-function-return-pc c-d-f)))
-                      frame)
+                       frame sb!vm::ocfp-save-offset
+                       (sb!c::compiled-debug-function-old-fp c-d-f)))
+                     (get-context-value
+                      frame sb!vm::lra-save-offset
+                      (sb!c::compiled-debug-function-return-pc c-d-f))
                      frame)))
                  (bogus-debug-function
-                  (let ((fp (frame-pointer real)))
+                  (let ((fp (frame-pointer frame)))
                     (when (cstack-pointer-valid-p fp)
                       #!+x86
                        (multiple-value-bind (ra ofp) (x86-call-context fp)
                         (sap-ref-32 fp (* sb!vm::ocfp-save-offset
                                           sb!vm:word-bytes)))
 
-                       #!-gengc
                        (stack-ref fp sb!vm::lra-save-offset)
-                       #!+gengc
-                       (sap-ref-sap fp (* sb!vm::ra-save-offset
-                                          sb!vm:word-bytes))
+
                        frame)))))))
        down)))
 
          (#.sb!vm::lra-save-offset
           (setf (sap-ref-sap pointer (- (* (1+ stack-slot) 4))) value))))))
 
-;;; This doesn't do anything in sbcl-0.7.0, since the functionality
-;;; was lost in the switch from IR1 interpreter to bytecode interpreter.
-;;; However, it might be revived someday. (See the FIXME for
-;;; POSSIBLY-AN-INTERPRETED-FRAME.)
-;;;
-;;; (defvar *debugging-interpreter* nil
-;;;   #!+sb-doc
-;;;   "When set, the debugger foregoes making interpreted frames, so you can
-;;;    debug the functions that manifest the interpreter.")
-
-;;; Note: In CMU CL with the IR1 interpreter, this did
-;;;    This takes a newly computed frame, FRAME, and the frame above it
-;;;    on the stack, UP-FRAME, which is possibly NIL. FRAME is NIL when
-;;;    we hit the bottom of the control stack. When FRAME represents a
-;;;    call to SB!BYTECODE::INTERNAL-APPLY-LOOP, we make an interpreted frame
-;;;    to replace FRAME. The interpreted frame points to FRAME.
-;;; But with SBCL's switch to byte-interpreter-only, this is functionality
-;;; wasn't maintained, so this is just a placeholder, and when you
-;;; try to "debug byte code" you end up debugging the byte interpreter
-;;; instead.
-;;; 
-;;; (It might be good to update the old CMU CL functionality so that
-;;; you can really debug byte code instead of seeing a bunch of
-;;; confusing byte interpreter implementation stuff, so I've left the
-;;; placeholder in place. But be aware that doing so is a big messy
-;;; job: grep for 'interpreted-debug-' in the sbcl-0.6.13 sources to
-;;; see what you're getting into. -- WHN)
-(defun possibly-an-interpreted-frame (frame up-frame)
-
-  ;; new SBCL code, not ambitious enough to do anything tricky like
-  ;; hiding the byte interpreter when debugging
-  (declare (ignore up-frame))
-  frame
-
-  ;; old CMU CL code to hide IR1 interpreter when debugging 
-  ;;
-  ;;(if (or (not frame)
-  ;;        (not (eq (debug-function-name (frame-debug-function
-  ;;                                       frame))
-  ;;                 'sb!bytecode::internal-apply-loop))
-  ;;        *debugging-interpreter*
-  ;;        (compiled-frame-escaped frame))
-  ;;    frame
-  ;;    (flet ((get-var (name location)
-  ;;             (let ((vars (sb!di:ambiguous-debug-vars
-  ;;                          (sb!di:frame-debug-function frame) name)))
-  ;;               (when (or (null vars) (> (length vars) 1))
-  ;;                 (error "zero or more than one ~A variable in ~
-  ;;                         SB!BYTECODE::INTERNAL-APPLY-LOOP"
-  ;;                        (string-downcase name)))
-  ;;               (if (eq (debug-var-validity (car vars) location)
-  ;;                       :valid)
-  ;;                   (car vars)))))
-  ;;      (let* ((code-loc (frame-code-location frame))
-  ;;             (ptr-var (get-var "FRAME-PTR" code-loc))
-  ;;             (node-var (get-var "NODE" code-loc))
-  ;;             (closure-var (get-var "CLOSURE" code-loc)))
-  ;;        (if (and ptr-var node-var closure-var)
-  ;;            (let* ((node (debug-var-value node-var frame))
-  ;;                   (d-fun (make-interpreted-debug-function
-  ;;                           (sb!c::block-home-lambda (sb!c::node-block
-  ;;                                                     node)))))
-  ;;              (make-interpreted-frame
-  ;;               (debug-var-value ptr-var frame)
-  ;;               up-frame
-  ;;               d-fun
-  ;;               (make-interpreted-code-location node d-fun)
-  ;;               (frame-number frame)
-  ;;               frame
-  ;;               (debug-var-value closure-var frame)))
-  ;;            frame))))
-  )
-
 ;;; This returns a frame for the one existing in time immediately
 ;;; prior to the frame referenced by current-fp. This is current-fp's
 ;;; caller or the next frame down the control stack. If there is no
 ;;; Note: Sometimes LRA is actually a fixnum. This happens when lisp
 ;;; calls into C. In this case, the code object is stored on the stack
 ;;; after the LRA, and the LRA is the word offset.
-#!-(or gengc x86)
+#!-x86
 (defun compute-calling-frame (caller lra up-frame)
   (declare (type system-area-pointer caller))
   (when (cstack-pointer-valid-p caller)
 #!+x86
 (defun compute-calling-frame (caller ra up-frame)
   (declare (type system-area-pointer caller ra))
+  (/show0 "entering COMPUTE-CALLING-FRAME")
   (when (cstack-pointer-valid-p caller)
+    (/show0 "in WHEN")
     ;; First check for an escaped frame.
     (multiple-value-bind (code pc-offset escaped) (find-escaped-frame caller)
-       (cond (code
-              ;; If it's escaped it may be a function end breakpoint trap.
-              (when (and (code-component-p code)
-                         (eq (%code-debug-info code) :bogus-lra))
-                ;; If :bogus-lra grab the real lra.
-                (setq pc-offset (code-header-ref
-                                 code (1+ real-lra-slot)))
-                (setq code (code-header-ref code real-lra-slot))
-                (aver code)))
-             (t
-              ;; not escaped
-              (multiple-value-setq (pc-offset code)
-                (compute-lra-data-from-pc ra))
-              (unless code
-                (setf code :foreign-function
-                      pc-offset 0
-                      escaped nil))))
-
-       (let ((d-fun (case code
-                          (:undefined-function
-                           (make-bogus-debug-function
-                            "undefined function"))
-                          (:foreign-function
-                           (make-bogus-debug-function
-                            "foreign function call land"))
-                          ((nil)
-                           (make-bogus-debug-function
-                            "bogus stack frame"))
-                          (t
-                           (debug-function-from-pc code pc-offset)))))
-         (make-compiled-frame caller up-frame d-fun
-                              (code-location-from-pc d-fun pc-offset
-                                                     escaped)
-                              (if up-frame (1+ (frame-number up-frame)) 0)
-                              escaped)))))
+      (/show0 "at COND")
+      (cond (code
+            (/show0 "in CODE clause")
+            ;; If it's escaped it may be a function end breakpoint trap.
+            (when (and (code-component-p code)
+                       (eq (%code-debug-info code) :bogus-lra))
+              ;; If :bogus-lra grab the real lra.
+              (setq pc-offset (code-header-ref
+                               code (1+ real-lra-slot)))
+              (setq code (code-header-ref code real-lra-slot))
+              (aver code)))
+           (t
+            (/show0 "in T clause")
+            ;; not escaped
+            (multiple-value-setq (pc-offset code)
+              (compute-lra-data-from-pc ra))
+            (unless code
+              (setf code :foreign-function
+                    pc-offset 0
+                    escaped nil))))
+
+      (let ((d-fun (case code
+                    (:undefined-function
+                     (make-bogus-debug-function
+                      "undefined function"))
+                    (:foreign-function
+                     (make-bogus-debug-function
+                      "foreign function call land"))
+                    ((nil)
+                     (make-bogus-debug-function
+                      "bogus stack frame"))
+                    (t
+                     (debug-function-from-pc code pc-offset)))))
+       (/show0 "returning MAKE-COMPILED-FRAME from COMPUTE-CALLING-FRAME")
+       (make-compiled-frame caller up-frame d-fun
+                            (code-location-from-pc d-fun pc-offset
+                                                   escaped)
+                            (if up-frame (1+ (frame-number up-frame)) 0)
+                            escaped)))))
 
 #!+x86
 (defun find-escaped-frame (frame-pointer)
   (declare (type system-area-pointer frame-pointer))
+  (/show0 "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))
+       ((lisp-interrupt-contexts (array (* os-context-t) nil) :extern))
+      (/show0 "at head of WITH-ALIEN")
       (let ((context (sb!alien:deref lisp-interrupt-contexts index)))
+       (/show0 "got CONTEXT")
        (when (= (sap-int frame-pointer)
                 (sb!vm:context-register context sb!vm::cfp-offset))
          (without-gcing
+          (/show0 "in WITHOUT-GCING")
           (let* ((component-ptr (component-ptr-from-pc
                                  (sb!vm:context-pc context)))
                  (code (unless (sap= component-ptr (int-sap #x0))
                          (component-from-component-ptr component-ptr))))
+            (/show0 "got CODE")
             (when (null code)
               (return (values code 0 context)))
             (let* ((code-header-len (* (get-header-data code)
                        (- (get-lisp-obj-address code)
                           sb!vm:other-pointer-type)
                        code-header-len)))
+              (/show "got PC-OFFSET")
               (unless (<= 0 pc-offset
                           (* (code-header-ref code sb!vm:code-code-size-slot)
                              sb!vm:word-bytes))
                 ;; FIXME: Should this be WARN or ERROR or what?
                 (format t "** pc-offset ~S not in code obj ~S?~%"
                         pc-offset code))
+              (/show0 "returning from FIND-ESCAPED-FRAME")
               (return
                (values code pc-offset context))))))))))
 
 ;;; Find the code object corresponding to the object represented by
 ;;; bits and return it. We assume bogus functions correspond to the
 ;;; undefined-function.
-#!-gengc
 (defun code-object-from-bits (bits)
   (declare (type (unsigned-byte 32) bits))
   (let ((object (make-lisp-obj bits)))
                       (lra-code-header object))
                      (t
                       nil))))))))
-
-;;; SB!KERNEL:*SAVED-STATE-CHAIN* -- maintained by the C code as a
-;;; list of SAPs, each SAP pointing to a saved exception state.
-#!+gengc
-(declaim (special *saved-state-chain*))
-
-;;; CMU CL had
-;;;   (DEFUN LOOKUP-TRACE-TABLE-ENTRY (COMPONENT PC) ..)
-;;; for this case, but it hasn't been maintained in SBCL.
-#!+gengc
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (error "hopelessly stale"))
-
-;;; CMU CL had
-;;;   (DEFUN EXTRACT-INFO-FROM-STATE (STATE) ..)
-;;; for this case, but it hasn't been maintained in SBCL.
-#!+gengc
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (error "hopelessly stale"))
-
-;;; CMU CL had
-;;;   (DEFUN COMPUTE-CALLING-FRAME (OCFP RA UP-FRAME) ..)
-;;; for this case, but it hasn't been maintained in SBCL.
-#!+gengc
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (error "hopelessly stale"))
 \f
 ;;;; frame utilities
 
 ;;; CODE-LOCATIONs at which execution would continue with frame as the
 ;;; top frame if someone threw to the corresponding tag.
 (defun frame-catches (frame)
-  (let ((catch
-        #!-gengc (descriptor-sap *current-catch-block*)
-        #!+gengc (mutator-current-catch-block))
+  (let ((catch (descriptor-sap *current-catch-block*))
        (res nil)
-       (fp (frame-pointer (frame-real-frame frame))))
+       (fp (frame-pointer frame)))
     (loop
       (when (zerop (sap-int catch)) (return (nreverse res)))
       (when (sap= fp
                   (sap-ref-32 catch
                                      (* sb!vm:catch-block-current-cont-slot
                                         sb!vm:word-bytes))))
-       (let* (#!-(or gengc x86)
+       (let* (#!-x86
               (lra (stack-ref catch sb!vm:catch-block-entry-pc-slot))
-              #!+(or gengc x86)
+              #!+x86
               (ra (sap-ref-sap
                    catch (* sb!vm:catch-block-entry-pc-slot
                             sb!vm:word-bytes)))
               (component (component-from-component-ptr
                           (component-ptr-from-pc ra)))
               (offset
-               #!-(or gengc x86)
+               #!-x86
                (* (- (1+ (get-header-data lra))
                      (get-header-data component))
                   sb!vm:word-bytes)
-               #!+gengc
-               (+ (- (sap-int ra)
-                     (get-lisp-obj-address component)
-                     (get-header-data component))
-                  sb!vm:other-pointer-type)
                #!+x86
                (- (sap-int ra)
                   (- (get-lisp-obj-address component)
             (sap-ref-32 catch
                                (* sb!vm:catch-block-previous-catch-slot
                                   sb!vm:word-bytes)))))))
-
-;;; If an interpreted frame, return the real frame, otherwise frame.
-(defun frame-real-frame (frame)
-  (etypecase frame
-    (compiled-frame frame)
-    (interpreted-frame (interpreted-frame-real-frame frame))))
 \f
 ;;;; operations on DEBUG-FUNCTIONs
 
       (setf (compiled-debug-var-symbol (svref vars i))
            (intern (format nil "ARG-~V,'0D" width i)
                    ;; KLUDGE: It's somewhat nasty to have a bare
-                   ;; package name string here. It would probably be
-                   ;; better to have #.(FIND-PACKAGE "SB!DEBUG")
+                   ;; package name string here. It would be
+                   ;; nicer to have #.(FIND-PACKAGE "SB!DEBUG")
                    ;; instead, since then at least it would transform
                    ;; correctly under package renaming and stuff.
                    ;; However, genesis can't handle dumped packages..
                    ;; would work fine) If this is possible, it would
                    ;; probably be a good thing, since minimizing the
                    ;; amount of stuff in cold init is basically good.
-                   "SB-DEBUG")))))
+                   (or (find-package "SB-DEBUG")
+                       (find-package "SB!DEBUG")))))))
 
 ;;; Parse the packed representation of DEBUG-VARs from
 ;;; DEBUG-FUNCTION's SB!C::COMPILED-DEBUG-FUNCTION, returning a vector
 ;;; of DEBUG-VARs, or NIL if there was no information to parse.
 (defun parse-compiled-debug-vars (debug-function)
-  (let* ((cdebug-fun (compiled-debug-function-compiler-debug-fun debug-function))
+  (let* ((cdebug-fun (compiled-debug-function-compiler-debug-fun
+                     debug-function))
         (packed-vars (sb!c::compiled-debug-function-variables cdebug-fun))
         (args-minimal (eq (sb!c::compiled-debug-function-arguments cdebug-fun)
                           :minimal)))
          (let* ((flags (geti))
                 (minimal (logtest sb!c::compiled-debug-var-minimal-p flags))
                 (deleted (logtest sb!c::compiled-debug-var-deleted-p flags))
-                (live (logtest sb!c::compiled-debug-var-environment-live flags))
+                (live (logtest sb!c::compiled-debug-var-environment-live
+                               flags))
                 (save (logtest sb!c::compiled-debug-var-save-loc-p flags))
                 (symbol (if minimal nil (geti)))
                 (id (if (logtest sb!c::compiled-debug-var-id-p flags)
 ;;; Returns the value stored for DEBUG-VAR in frame. The value may be
 ;;; invalid. This is SETFable.
 (defun debug-var-value (debug-var frame)
-  (etypecase debug-var
-    (compiled-debug-var
-     (aver (typep frame 'compiled-frame))
-     (let ((res (access-compiled-debug-var-slot debug-var frame)))
-       (if (indirect-value-cell-p res)
-          (value-cell-ref res)
-          res)))
-    ;; (This function used to be more interesting, with more type
-    ;; cases here, before the IR1 interpreter went away. It might
-    ;; become more interesting again if we ever try to generalize the
-    ;; CMU CL POSSIBLY-AN-INTERPRETED-FRAME thing to elide
-    ;; internal-to-the-byte-interpreter debug frames the way that CMU
-    ;; CL elided internal-to-the-IR1-interpreter debug frames.)
-    ))
+  (aver (typep frame 'compiled-frame))
+  (let ((res (access-compiled-debug-var-slot debug-var frame)))
+    (if (indirect-value-cell-p res)
+       (value-cell-ref res)
+       res)))
 
 ;;; This returns what is stored for the variable represented by
 ;;; DEBUG-VAR relative to the FRAME. This may be an indirect value
 ;;; COMPILED-DEBUG-VAR case, access the current value to determine if
 ;;; it is an indirect value cell. This occurs when the variable is
 ;;; both closed over and set.
-(defun %set-debug-var-value (debug-var frame value)
-  (etypecase debug-var
-    (compiled-debug-var
-     (aver (typep frame 'compiled-frame))
-     (let ((current-value (access-compiled-debug-var-slot debug-var frame)))
-       (if (indirect-value-cell-p current-value)
-          (value-cell-set current-value value)
-          (set-compiled-debug-var-slot debug-var frame value))))
-    ;; (This function used to be more interesting, with more type
-    ;; cases here, before the IR1 interpreter went away. It might
-    ;; become more interesting again if we ever try to generalize the
-    ;; CMU CL POSSIBLY-AN-INTERPRETED-FRAME thing to elide
-    ;; internal-to-the-byte-interpreter debug frames the way that CMU
-    ;; CL elided internal-to-the-IR1-interpreter debug frames.)
-    )
-  value)
-
-;;; This stores value for the variable represented by debug-var
+(defun %set-debug-var-value (debug-var frame new-value)
+  (aver (typep frame 'compiled-frame))
+  (let ((old-value (access-compiled-debug-var-slot debug-var frame)))
+    (if (indirect-value-cell-p old-value)
+       (value-cell-set old-value new-value)
+       (set-compiled-debug-var-slot debug-var frame new-value)))
+  new-value)
+
+;;; This stores VALUE for the variable represented by debug-var
 ;;; relative to the frame. This assumes the location directly contains
 ;;; the variable's value; that is, there is no indirect value cell
 ;;; currently there in case the variable is both closed over and set.
        (multiple-value-bind (lra component offset)
            (make-bogus-lra
             (get-context-value frame
-                               #!-gengc sb!vm::lra-save-offset
-                               #!+gengc sb!vm::ra-save-offset
+                               sb!vm::lra-save-offset
                                lra-sc-offset))
          (setf (get-context-value frame
-                                  #!-gengc sb!vm::lra-save-offset
-                                  #!+gengc sb!vm::ra-save-offset
+                                  sb!vm::lra-save-offset
                                   lra-sc-offset)
                lra)
          (let ((end-bpts (breakpoint-%info starter-bpt)))
       (when (and (compiled-frame-p frame)
                 (eq lra
                     (get-context-value frame
-                                       #!-gengc sb!vm::lra-save-offset
-                                       #!+gengc sb!vm::ra-save-offset
+                                       sb!vm::lra-save-offset
                                        lra-sc-offset)))
        (return t)))))
 \f