-;;; 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))
- (/show "doing trivial POSSIBLY-AN-INTERPRETED-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))))
- )
-