;;; XXX Should probably check whether it has reached the bottom of the
;;; stack.
;;;
-;;; XXX Should handle interrupted frames, both Lisp and C. At present it
-;;; manages to find a fp trail, see linux hack below.
-(defun x86-call-context (fp &key (depth 8))
+;;; XXX Should handle interrupted frames, both Lisp and C. At present
+;;; it manages to find a fp trail, see linux hack below.
+(defun x86-call-context (fp &key (depth 0))
(declare (type system-area-pointer fp)
(fixnum depth))
;;(format t "*CC ~S ~S~%" fp depth)
lisp-ocfp lisp-ra c-ocfp c-ra)
;; Look forward another step to check their validity.
(let ((lisp-path-fp (x86-call-context lisp-ocfp
- :depth (- depth 1)))
- (c-path-fp (x86-call-context c-ocfp :depth (- depth 1))))
+ :depth (1+ depth)))
+ (c-path-fp (x86-call-context c-ocfp :depth (1+ depth))))
(cond ((and lisp-path-fp c-path-fp)
- ;; Both still seem valid - choose the smallest.
- #+nil (format t "debug: both still valid ~S ~S ~S ~S~%"
- lisp-ocfp lisp-ra c-ocfp c-ra)
- (if (sap< lisp-ocfp c-ocfp)
- (values lisp-ra lisp-ocfp)
- (values c-ra c-ocfp)))
+ ;; Both still seem valid - choose the lisp frame.
+ #+nil (when (zerop depth)
+ (format t "debug: both still valid ~S ~S ~S ~S~%"
+ lisp-ocfp lisp-ra c-ocfp c-ra))
+ #+freebsd
+ (if (sap> lisp-ocfp c-ocfp)
+ (values lisp-ra lisp-ocfp)
+ (values c-ra c-ocfp))
+ #-freebsd
+ (values lisp-ra lisp-ocfp))
(lisp-path-fp
;; The lisp convention is looking good.
#+nil (format t "*C lisp-ocfp ~S ~S~%" lisp-ocfp lisp-ra)
(coerce (cdr (res)) 'simple-vector))))
-;;; This variable maps minimal debug-info function maps to an unpacked
-;;; version thereof.
+;;; a map from minimal DEBUG-INFO function maps to unpacked
+;;; versions thereof
(defvar *uncompacted-function-maps* (make-hash-table :test 'eq))
-;;; Return a function-map for a given compiled-debug-info object. If
+;;; Return a FUNCTION-MAP for a given COMPILED-DEBUG-info object. If
;;; the info is minimal, and has not been parsed, then parse it.
;;;
-;;; FIXME: Now that we no longer use the minimal-debug-function
+;;; FIXME: Now that we no longer use the MINIMAL-DEBUG-FUNCTION
;;; representation, calls to this function can be replaced by calls to
;;; the bare COMPILED-DEBUG-INFO-FUNCTION-MAP slot accessor function,
;;; and this function and everything it calls become dead code which
\f
;;;; CODE-LOCATIONs
-;;; If we're sure of whether code-location is known, return t or nil.
-;;; If we're :unsure, then try to fill in the code-location's slots.
+;;; If we're sure of whether code-location is known, return T or NIL.
+;;; If we're :UNSURE, then try to fill in the code-location's slots.
;;; This determines whether there is any debug-block information, and
;;; if code-location is known.
;;;
;;; ??? IF this conses closures every time it's called, then break off the
-;;; :unsure part to get the HANDLER-CASE into another function.
+;;; :UNSURE part to get the HANDLER-CASE into another function.
(defun code-location-unknown-p (basic-code-location)
- #!+sb-doc
- "Returns whether basic-code-location is unknown. It returns nil when the
- code-location is known."
(ecase (code-location-%unknown-p basic-code-location)
((t) t)
((nil) nil)
(handler-case (not (fill-in-code-location basic-code-location))
(no-debug-blocks () t))))))
+;;; Return the DEBUG-BLOCK containing code-location if it is available.
+;;; Some debug policies inhibit debug-block information, and if none
+;;; is available, then this signals a NO-DEBUG-BLOCKS condition.
(defun code-location-debug-block (basic-code-location)
- #!+sb-doc
- "Returns the debug-block containing code-location if it is available. Some
- debug policies inhibit debug-block information, and if none is available,
- then this signals a no-debug-blocks condition."
(let ((block (code-location-%debug-block basic-code-location)))
(if (eq block :unparsed)
(etypecase basic-code-location
(interpreted-code-location-ir1-node basic-code-location))))))
block)))
-;;; This stores and returns BASIC-CODE-LOCATION's debug-block. It
-;;; determines the correct one using the code-location's pc. This uses
+;;; Store and return BASIC-CODE-LOCATION's debug-block. We determines
+;;; the correct one using the code-location's pc. We use
;;; DEBUG-FUNCTION-DEBUG-BLOCKS to return the cached block information
-;;; or signal a 'no-debug-blocks condition. The blocks are sorted by
+;;; or signal a NO-DEBUG-BLOCKS condition. The blocks are sorted by
;;; their first code-location's pc, in ascending order. Therefore, as
;;; soon as we find a block that starts with a pc greater than
;;; basic-code-location's pc, we know the previous block contains the
(let ((live-set (compiled-code-location-%live-set code-location)))
(cond ((eq live-set :unparsed)
(unless (fill-in-code-location code-location)
- ;; This check should be unnecessary. We're missing debug info
- ;; the compiler should have dumped.
+ ;; This check should be unnecessary. We're missing
+ ;; debug info the compiler should have dumped.
;;
;; FIXME: This error and comment happen over and over again.
;; Make them a shared function.
(compiled-code-location-%live-set code-location))
(t live-set)))))
+;;; true if OBJ1 and OBJ2 are the same place in the code
(defun code-location= (obj1 obj2)
- #!+sb-doc
- "Returns whether obj1 and obj2 are the same place in the code."
(etypecase obj1
(compiled-code-location
(etypecase obj2
(= (compiled-code-location-pc obj1)
(compiled-code-location-pc obj2)))
-;;; This fills in CODE-LOCATION's :unparsed slots. It returns t or nil
+;;; Fill in CODE-LOCATION's :UNPARSED slots, returning T or NIL
;;; depending on whether the code-location was known in its
;;; debug-function's debug-block information. This may signal a
;;; NO-DEBUG-BLOCKS condition due to DEBUG-FUNCTION-DEBUG-BLOCKS, and
: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))
- #!+sb-doc
- "Evaluate Form in the lexical context of Frame's current code location,
- returning the results of the evaluation."
(funcall (preprocess-for-eval form (frame-code-location frame)) frame))
\f
;;;; breakpoints
;;;; user-visible interface
+;;; Create and return a breakpoint. When program execution encounters
+;;; the breakpoint, the system calls HOOK-FUNCTION. HOOK-FUNCTION takes the
+;;; current frame for the function in which the program is running and the
+;;; breakpoint object.
+;;;
+;;; WHAT and KIND determine where in a function the system invokes
+;;; HOOK-FUNCTION. WHAT is either a code-location or a debug-function.
+;;; KIND is one of :CODE-LOCATION, :FUNCTION-START, or :FUNCTION-END.
+;;; Since the starts and ends of functions may not have code-locations
+;;; representing them, designate these places by supplying WHAT as a
+;;; debug-function and KIND indicating the :FUNCTION-START or
+;;; :FUNCTION-END. When WHAT is a debug-function and kind is
+;;; :FUNCTION-END, then hook-function must take two additional
+;;; arguments, a list of values returned by the function and a
+;;; FUNCTION-END-COOKIE.
+;;;
+;;; INFO is information supplied by and used by the user.
+;;;
+;;; FUNCTION-END-COOKIE is a function. To implement :FUNCTION-END
+;;; breakpoints, the system uses starter breakpoints to establish the
+;;; :FUNCTION-END breakpoint for each invocation of the function. Upon
+;;; each entry, the system creates a unique cookie to identify the
+;;; invocation, and when the user supplies a function for this
+;;; argument, the system invokes it on the frame and the cookie. The
+;;; system later invokes the :FUNCTION-END breakpoint hook on the same
+;;; cookie. The user may save the cookie for comparison in the hook
+;;; function.
+;;;
+;;; Signal an error if WHAT is an unknown code-location.
(defun make-breakpoint (hook-function what
&key (kind :code-location) info function-end-cookie)
- #!+sb-doc
- "This creates and returns a breakpoint. When program execution encounters
- the breakpoint, the system calls hook-function. Hook-function takes the
- current frame for the function in which the program is running and the
- breakpoint object.
- What and kind determine where in a function the system invokes
- hook-function. What is either a code-location or a debug-function. Kind is
- one of :code-location, :function-start, or :function-end. Since the starts
- and ends of functions may not have code-locations representing them,
- designate these places by supplying what as a debug-function and kind
- indicating the :function-start or :function-end. When what is a
- debug-function and kind is :function-end, then hook-function must take two
- additional arguments, a list of values returned by the function and a
- function-end-cookie.
- Info is information supplied by and used by the user.
- Function-end-cookie is a function. To implement :function-end breakpoints,
- the system uses starter breakpoints to establish the :function-end breakpoint
- for each invocation of the function. Upon each entry, the system creates a
- unique cookie to identify the invocation, and when the user supplies a
- function for this argument, the system invokes it on the frame and the
- cookie. The system later invokes the :function-end breakpoint hook on the
- same cookie. The user may save the cookie for comparison in the hook
- function.
- This signals an error if what is an unknown code-location."
(etypecase what
(code-location
(when (code-location-unknown-p what)
;; This is the debug-function associated with the cookie.
debug-fun)
-;;; This maps bogus-lra-components to cookies, so
+;;; This maps bogus-lra-components to cookies, so that
;;; HANDLE-FUNCTION-END-BREAKPOINT can find the appropriate cookie for the
;;; breakpoint hook.
(defvar *function-end-cookies* (make-hash-table :test 'eq))
(let ((fun (breakpoint-cookie-fun bpt)))
(when fun (funcall fun frame cookie))))))))))
+;;; This takes a FUNCTION-END-COOKIE and a frame, and it returns
+;;; whether the cookie is still valid. A cookie becomes invalid when
+;;; the frame that established the cookie has exited. Sometimes cookie
+;;; holders are unaware of cookie invalidation because their
+;;; :FUNCTION-END breakpoint hooks didn't run due to THROW'ing.
+;;;
+;;; This takes a frame as an efficiency hack since the user probably
+;;; has a frame object in hand when using this routine, and it saves
+;;; repeated parsing of the stack and consing when asking whether a
+;;; series of cookies is valid.
(defun function-end-cookie-valid-p (frame cookie)
- #!+sb-doc
- "This takes a function-end-cookie and a frame, and it returns whether the
- cookie is still valid. A cookie becomes invalid when the frame that
- established the cookie has exited. Sometimes cookie holders are unaware
- of cookie invalidation because their :function-end breakpoint hooks didn't
- run due to THROW'ing. This takes a frame as an efficiency hack since the
- user probably has a frame object in hand when using this routine, and it
- saves repeated parsing of the stack and consing when asking whether a
- series of cookies is valid."
(let ((lra (function-end-cookie-bogus-lra cookie))
(lra-sc-offset (sb!c::compiled-debug-function-return-pc
(compiled-debug-function-compiler-debug-fun
#!+gengc sb!vm::ra-save-offset
lra-sc-offset)))
(return t)))))
-
+\f
;;;; ACTIVATE-BREAKPOINT
+;;; Cause the system to invoke the breakpoint's hook-function until
+;;; the next call to DEACTIVATE-BREAKPOINT or DELETE-BREAKPOINT. The
+;;; system invokes breakpoint hook functions in the opposite order
+;;; that you activate them.
(defun activate-breakpoint (breakpoint)
- #!+sb-doc
- "This causes the system to invoke the breakpoint's hook-function until the
- next call to DEACTIVATE-BREAKPOINT or DELETE-BREAKPOINT. The system invokes
- breakpoint hook functions in the opposite order that you activate them."
(when (eq (breakpoint-status breakpoint) :deleted)
(error "cannot activate a deleted breakpoint: ~S" breakpoint))
(unless (eq (breakpoint-status breakpoint) :active)
(compiled-debug-function
(let ((starter (breakpoint-start-helper breakpoint)))
(unless (eq (breakpoint-status starter) :active)
- ;; May already be active by some other :function-end breakpoint.
+ ;; may already be active by some other :FUNCTION-END breakpoint
(activate-compiled-function-start-breakpoint starter)))
(setf (breakpoint-status breakpoint) :active))
(interpreted-debug-function
(setf (breakpoint-data-breakpoints data)
(append (breakpoint-data-breakpoints data) (list breakpoint)))
(setf (breakpoint-internal-data breakpoint) data)))
-
+\f
;;;; DEACTIVATE-BREAKPOINT
(defun deactivate-breakpoint (breakpoint)
(delete-breakpoint-data data))))
(setf (breakpoint-status breakpoint) :inactive)
breakpoint)
-
+\f
;;;; BREAKPOINT-INFO
(defun breakpoint-info (breakpoint)
(let ((other (breakpoint-unknown-return-partner breakpoint)))
(when other
(setf (breakpoint-%info other) value))))
-
+\f
;;;; BREAKPOINT-ACTIVE-P and DELETE-BREAKPOINT
(defun breakpoint-active-p (breakpoint)
(breakpoint-what breakpoint))
nil))))))
breakpoint)
-
+\f
;;;; C call out stubs
;;; This actually installs the break instruction in the component. It
(stack-ref ocfp arg-num))
results)))
(nreverse results)))
-
+\f
;;;; MAKE-BOGUS-LRA (used for :FUNCTION-END breakpoints)
(defconstant
projects / sbcl.git / blobdiff