X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug-int.lisp;h=e066ee8aed750d3aa97e44998c9baf3a6612d274;hb=b8f63d9b4e978bec3bfc1f4fc471e5ed946781fd;hp=ae9439d3b830dd11f09241e7bd8fe650336c6a9a;hpb=95a6db7329b91dd90d165dd4057b9b5098d34aa2;p=sbcl.git diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index ae9439d..e066ee8 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -1112,9 +1112,8 @@ (without-gcing (let* ((component-ptr (component-ptr-from-pc (sb!vm:context-pc context))) - (code (if (sap= component-ptr (int-sap #x0)) - nil ; FIXME: UNLESS might be clearer than IF. - (component-from-component-ptr component-ptr)))) + (code (unless (sap= component-ptr (int-sap #x0)) + (component-from-component-ptr component-ptr)))) (when (null code) (return (values code 0 context))) (let* ((code-header-len (* (get-header-data code) @@ -1127,8 +1126,10 @@ (unless (<= 0 pc-offset (* (code-header-ref code sb!vm:code-code-size-slot) sb!vm:word-bytes)) - ;; We were in an assembly routine. Therefore, use the LRA as - ;; the pc. + ;; We were in an assembly routine. Therefore, use the + ;; LRA as the pc. + ;; + ;; FIXME: Should this be WARN or ERROR or what? (format t "** pc-offset ~S not in code obj ~S?~%" pc-offset code)) (return @@ -1204,8 +1205,7 @@ (elsewhere-p (>= pc (sb!c::compiled-debug-function-elsewhere-pc (svref function-map 0))))) - ;; FIXME: I don't think SB!C is the home package of INDEX. - (declare (type sb!c::index i)) + (declare (type sb!int:index i)) (loop (when (or (= i len) (< pc (if elsewhere-p @@ -2067,14 +2067,14 @@ (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 @@ -2090,17 +2090,14 @@ ;;;; 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) @@ -2109,11 +2106,10 @@ (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 @@ -2126,10 +2122,10 @@ (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 @@ -2280,8 +2276,8 @@ (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. @@ -2289,9 +2285,8 @@ (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 @@ -2312,7 +2307,7 @@ (= (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 @@ -3121,43 +3116,47 @@ :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)) ;;;; 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) @@ -3217,7 +3216,7 @@ ;; 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)) @@ -3260,16 +3259,17 @@ (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 @@ -3283,14 +3283,14 @@ #!+gengc sb!vm::ra-save-offset lra-sc-offset))) (return t))))) - + ;;;; 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) @@ -3317,7 +3317,7 @@ (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 @@ -3365,7 +3365,7 @@ (setf (breakpoint-data-breakpoints data) (append (breakpoint-data-breakpoints data) (list breakpoint))) (setf (breakpoint-internal-data breakpoint) data))) - + ;;;; DEACTIVATE-BREAKPOINT (defun deactivate-breakpoint (breakpoint) @@ -3406,7 +3406,7 @@ (delete-breakpoint-data data)))) (setf (breakpoint-status breakpoint) :inactive) breakpoint) - + ;;;; BREAKPOINT-INFO (defun breakpoint-info (breakpoint) @@ -3419,7 +3419,7 @@ (let ((other (breakpoint-unknown-return-partner breakpoint))) (when other (setf (breakpoint-%info other) value)))) - + ;;;; BREAKPOINT-ACTIVE-P and DELETE-BREAKPOINT (defun breakpoint-active-p (breakpoint) @@ -3453,7 +3453,7 @@ (breakpoint-what breakpoint)) nil)))))) breakpoint) - + ;;;; C call out stubs ;;; This actually installs the break instruction in the component. It @@ -3632,7 +3632,7 @@ (stack-ref ocfp arg-num)) results))) (nreverse results))) - + ;;;; MAKE-BOGUS-LRA (used for :FUNCTION-END breakpoints) (defconstant