(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)
- (sb!c: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)
- (sb!c: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.
;;; at BASIC-CODE-LOCATION:
;;; :VALID The value is known to be available.
;;; :INVALID The value is known to be unavailable.
-;;; :UNKNOWN The value's availability is unknown."
+;;; :UNKNOWN The value's availability is unknown.
;;;
;;; If the variable is always alive, then it is valid. If the
;;; code-location is unknown, then the variable's validity is
(cons res (nthcdr (1+ n) form))))))))
(frob form path context))))
\f
-;;;; PREPROCESS-FOR-EVAL and EVAL-IN-FRAME
+;;;; PREPROCESS-FOR-EVAL
;;; Return a function of one argument that evaluates form in the
;;; lexical context of the BASIC-CODE-LOCATION LOC, or signal a
(debug-signal 'frame-function-mismatch
:code-location loc :form form :frame frame))
(funcall res frame))))))
-
-;;; Evaluate FORM in the lexical context of FRAME's current code
-;;; location, returning the results of the evaluation.
-(defun eval-in-frame (frame form)
- (declare (type frame frame))
- (funcall (preprocess-for-eval form (frame-code-location frame)) frame))
\f
;;;; breakpoints
(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