X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug-int.lisp;h=071a476058eb2e0be6c081e288622f9fd6d4649b;hb=90ca09b75fbc3b63b2f7d09c67b04b866dd783f6;hp=c2b2757ea74803b97f0c2ae2cbc226fc290ee841;hpb=89eb73c035f05ae53b1148ef8a83e1d4030b2dd8;p=sbcl.git diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index c2b2757..071a476 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -195,7 +195,7 @@ (defstruct (debug-var (:constructor nil) (:copier nil)) ;; the name of the variable - (symbol (required-argument) :type symbol) + (symbol (missing-arg) :type symbol) ;; a unique integer identification relative to other variables with the same ;; symbol (id 0 :type index) @@ -204,7 +204,7 @@ (def!method print-object ((debug-var debug-var) stream) (print-unreadable-object (debug-var stream :type t :identity t) (format stream - "~S ~D" + "~S ~W" (debug-var-symbol debug-var) (debug-var-id debug-var)))) @@ -454,9 +454,9 @@ ;; the DEBUG-FUN containing this CODE-LOCATION (debug-fun nil :type debug-fun) ;; This is initially :UNSURE. Upon first trying to access an - ;; :unparsed slot, if the data is unavailable, then this becomes t, + ;; :UNPARSED slot, if the data is unavailable, then this becomes T, ;; and the code-location is unknown. If the data is available, this - ;; becomes nil, a known location. We can't use a separate type + ;; becomes NIL, a known location. We can't use a separate type ;; code-location for this since we must return code-locations before ;; we can tell whether they're known or unknown. For example, when ;; parsing the stack, we don't want to unpack all the variables and @@ -466,10 +466,10 @@ ;; out and just find it in the blocks cache in DEBUG-FUN. (%debug-block :unparsed :type (or debug-block (member :unparsed))) ;; This is the number of forms processed by the compiler or loader - ;; before the top-level form containing this code-location. + ;; before the top level form containing this code-location. (%tlf-offset :unparsed :type (or index (member :unparsed))) ;; This is the depth-first number of the node that begins - ;; code-location within its top-level form. + ;; code-location within its top level form. (%form-number :unparsed :type (or index (member :unparsed)))) (def!method print-object ((obj code-location) str) (print-unreadable-object (obj str :type t) @@ -495,12 +495,12 @@ ;;;; DEBUG-SOURCEs -;;; Return the number of top-level forms processed by the compiler +;;; Return the number of top level forms processed by the compiler ;;; before compiling this source. If this source is uncompiled, this ;;; is zero. This may be zero even if the source is compiled since the ;;; first form in the first file compiled in one compilation, for ;;; example, must have a root number of zero -- the compiler saw no -;;; other top-level forms before it. +;;; other top level forms before it. (defun debug-source-root-number (debug-source) (sb!c::debug-source-source-root debug-source)) @@ -538,7 +538,7 @@ (zerop (logand (sap-int x) #b11)))) #!+x86 -(sb!alien:def-alien-routine component-ptr-from-pc (system-area-pointer) +(sb!alien:define-alien-routine component-ptr-from-pc (system-area-pointer) (pc system-area-pointer)) #!+x86 @@ -666,7 +666,7 @@ ;;; Return the top frame of the control stack as it was before calling ;;; this function. (defun top-frame () - (/show0 "entering TOP-FRAME") + (/noshow0 "entering TOP-FRAME") (multiple-value-bind (fp pc) (%caller-frame-and-pc) (compute-calling-frame (descriptor-sap fp) pc nil))) @@ -682,13 +682,13 @@ ;;; 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") + (/noshow0 "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 ((debug-fun (frame-debug-fun frame))) - (/show0 "in DOWN :UNPARSED case") + (/noshow0 "in DOWN :UNPARSED case") (setf (frame-%down frame) (etypecase debug-fun (compiled-debug-fun @@ -777,8 +777,8 @@ ;;; 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 -;;; down frame, this returns nil for the bottom of the stack. Up-frame -;;; is the up link for the resulting frame object, and it is nil when +;;; down frame, this returns NIL for the bottom of the stack. UP-FRAME +;;; is the up link for the resulting frame object, and it is null when ;;; we call this to get the top of the stack. ;;; ;;; The current frame contains the pointer to the temporally previous @@ -831,18 +831,17 @@ escaped) (if up-frame (1+ (frame-number up-frame)) 0) escaped)))))) - #!+x86 (defun compute-calling-frame (caller ra up-frame) (declare (type system-area-pointer caller ra)) - (/show0 "entering COMPUTE-CALLING-FRAME") + (/noshow0 "entering COMPUTE-CALLING-FRAME") (when (cstack-pointer-valid-p caller) - (/show0 "in WHEN") + (/noshow0 "in WHEN") ;; First check for an escaped frame. (multiple-value-bind (code pc-offset escaped) (find-escaped-frame caller) - (/show0 "at COND") + (/noshow0 "at COND") (cond (code - (/show0 "in CODE clause") + (/noshow0 "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)) @@ -852,7 +851,7 @@ (setq code (code-header-ref code real-lra-slot)) (aver code))) (t - (/show0 "in T clause") + (/noshow0 "in T clause") ;; not escaped (multiple-value-setq (pc-offset code) (compute-lra-data-from-pc ra)) @@ -873,7 +872,7 @@ "bogus stack frame")) (t (debug-fun-from-pc code pc-offset))))) - (/show0 "returning MAKE-COMPILED-FRAME from COMPUTE-CALLING-FRAME") + (/noshow0 "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) @@ -883,22 +882,22 @@ #!+x86 (defun find-escaped-frame (frame-pointer) (declare (type system-area-pointer frame-pointer)) - (/show0 "entering FIND-ESCAPED-FRAME") + (/noshow0 "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)) - (/show0 "at head of WITH-ALIEN") + (/noshow0 "at head of WITH-ALIEN") (let ((context (sb!alien:deref lisp-interrupt-contexts index))) - (/show0 "got CONTEXT") + (/noshow0 "got CONTEXT") (when (= (sap-int frame-pointer) (sb!vm:context-register context sb!vm::cfp-offset)) (without-gcing - (/show0 "in WITHOUT-GCING") + (/noshow0 "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") + (/noshow0 "got CODE") (when (null code) (return (values code 0 context))) (let* ((code-header-len (* (get-header-data code) @@ -908,7 +907,7 @@ (- (get-lisp-obj-address code) sb!vm:other-pointer-lowtag) code-header-len))) - (/show "got PC-OFFSET") + (/noshow "got PC-OFFSET") (unless (<= 0 pc-offset (* (code-header-ref code sb!vm:code-code-size-slot) sb!vm:n-word-bytes)) @@ -918,7 +917,7 @@ ;; 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") + (/noshow0 "returning from FIND-ESCAPED-FRAME") (return (values code pc-offset context)))))))))) @@ -975,22 +974,22 @@ (if (functionp object) (or (fun-code-header object) :undefined-function) - (let ((lowtag (get-lowtag object))) + (let ((lowtag (lowtag-of object))) (if (= lowtag sb!vm:other-pointer-lowtag) - (let ((type (get-type object))) - (cond ((= type sb!vm:code-header-widetag) + (let ((widetag (widetag-of object))) + (cond ((= widetag sb!vm:code-header-widetag) object) - ((= type sb!vm:return-pc-header-widetag) + ((= widetag sb!vm:return-pc-header-widetag) (lra-code-header object)) (t nil)))))))) ;;;; frame utilities -;;; This returns a COMPILED-DEBUG-FUN for code and pc. We fetch the +;;; This returns a COMPILED-DEBUG-FUN for COMPONENT and PC. We fetch the ;;; SB!C::DEBUG-INFO and run down its FUN-MAP to get a -;;; SB!C::COMPILED-DEBUG-FUN from the pc. The result only needs to -;;; reference the component, for function constants, and the +;;; SB!C::COMPILED-DEBUG-FUN from the PC. The result only needs to +;;; reference the COMPONENT, for function constants, and the ;;; SB!C::COMPILED-DEBUG-FUN. (defun debug-fun-from-pc (component pc) (let ((info (%code-debug-info component))) @@ -1000,7 +999,7 @@ ((eq info :bogus-lra) (make-bogus-debug-fun "function end breakpoint")) (t - (let* ((fun-map (get-debug-info-fun-map info)) + (let* ((fun-map (sb!c::compiled-debug-info-fun-map info)) (len (length fun-map))) (declare (type simple-vector fun-map)) (if (= len 1) @@ -1043,62 +1042,63 @@ ;;; 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 (descriptor-sap *current-catch-block*)) - (res nil) + (let ((catch (descriptor-sap sb!vm:*current-catch-block*)) + (reversed-result nil) (fp (frame-pointer frame))) - (loop - (when (zerop (sap-int catch)) (return (nreverse res))) - (when (sap= fp - #!-alpha - (sap-ref-sap catch - (* sb!vm:catch-block-current-cont-slot - sb!vm:n-word-bytes)) - #!+alpha - (:int-sap - (sap-ref-32 catch - (* sb!vm:catch-block-current-cont-slot - sb!vm:n-word-bytes)))) - (let* (#!-x86 - (lra (stack-ref catch sb!vm:catch-block-entry-pc-slot)) - #!+x86 - (ra (sap-ref-sap - catch (* sb!vm:catch-block-entry-pc-slot - sb!vm:n-word-bytes))) - #!-x86 - (component - (stack-ref catch sb!vm:catch-block-current-code-slot)) - #!+x86 - (component (component-from-component-ptr - (component-ptr-from-pc ra))) - (offset - #!-x86 - (* (- (1+ (get-header-data lra)) - (get-header-data component)) - sb!vm:n-word-bytes) - #!+x86 - (- (sap-int ra) - (- (get-lisp-obj-address component) - sb!vm:other-pointer-lowtag) - (* (get-header-data component) sb!vm:n-word-bytes)))) - (push (cons #!-x86 - (stack-ref catch sb!vm:catch-block-tag-slot) - #!+x86 - (make-lisp-obj - (sap-ref-32 catch (* sb!vm:catch-block-tag-slot - sb!vm:n-word-bytes))) - (make-compiled-code-location - offset (frame-debug-fun frame))) - res))) - (setf catch - #!-alpha - (sap-ref-sap catch - (* sb!vm:catch-block-previous-catch-slot - sb!vm:n-word-bytes)) - #!+alpha - (:int-sap - (sap-ref-32 catch - (* sb!vm:catch-block-previous-catch-slot - sb!vm:n-word-bytes))))))) + (loop until (zerop (sap-int catch)) + finally (return (nreverse reversed-result)) + do + (when (sap= fp + #!-alpha + (sap-ref-sap catch + (* sb!vm:catch-block-current-cont-slot + sb!vm:n-word-bytes)) + #!+alpha + (int-sap + (sap-ref-32 catch + (* sb!vm:catch-block-current-cont-slot + sb!vm:n-word-bytes)))) + (let* (#!-x86 + (lra (stack-ref catch sb!vm:catch-block-entry-pc-slot)) + #!+x86 + (ra (sap-ref-sap + catch (* sb!vm:catch-block-entry-pc-slot + sb!vm:n-word-bytes))) + #!-x86 + (component + (stack-ref catch sb!vm:catch-block-current-code-slot)) + #!+x86 + (component (component-from-component-ptr + (component-ptr-from-pc ra))) + (offset + #!-x86 + (* (- (1+ (get-header-data lra)) + (get-header-data component)) + sb!vm:n-word-bytes) + #!+x86 + (- (sap-int ra) + (- (get-lisp-obj-address component) + sb!vm:other-pointer-lowtag) + (* (get-header-data component) sb!vm:n-word-bytes)))) + (push (cons #!-x86 + (stack-ref catch sb!vm:catch-block-tag-slot) + #!+x86 + (make-lisp-obj + (sap-ref-32 catch (* sb!vm:catch-block-tag-slot + sb!vm:n-word-bytes))) + (make-compiled-code-location + offset (frame-debug-fun frame))) + reversed-result))) + (setf catch + #!-alpha + (sap-ref-sap catch + (* sb!vm:catch-block-previous-catch-slot + sb!vm:n-word-bytes)) + #!+alpha + (int-sap + (sap-ref-32 catch + (* sb!vm:catch-block-previous-catch-slot + sb!vm:n-word-bytes))))))) ;;;; operations on DEBUG-FUNs @@ -1163,6 +1163,7 @@ ;;; Return the name of the function represented by DEBUG-FUN. This may ;;; be a string or a cons; do not assume it is a symbol. (defun debug-fun-name (debug-fun) + (declare (type debug-fun debug-fun)) (etypecase debug-fun (compiled-debug-fun (sb!c::compiled-debug-fun-name @@ -1173,7 +1174,7 @@ ;;; Return a DEBUG-FUN that represents debug information for FUN. (defun fun-debug-fun (fun) (declare (type function fun)) - (ecase (get-type fun) + (ecase (widetag-of fun) (#.sb!vm:closure-header-widetag (fun-debug-fun (%closure-fun fun))) (#.sb!vm:funcallable-instance-header-widetag @@ -1187,7 +1188,7 @@ (and (sb!c::compiled-debug-fun-p x) (eq (sb!c::compiled-debug-fun-name x) name) (eq (sb!c::compiled-debug-fun-kind x) nil))) - (get-debug-info-fun-map + (sb!c::compiled-debug-info-fun-map (%code-debug-info component))))) (if res (make-compiled-debug-fun res component) @@ -1205,7 +1206,7 @@ sb!vm:n-word-bytes))))))) ;;; Return the kind of the function, which is one of :OPTIONAL, -;;; :EXTERNAL, TOP-level, :CLEANUP, or NIL. +;;; :EXTERNAL, :TOPLEVEL, :CLEANUP, or NIL. (defun debug-fun-kind (debug-fun) ;; FIXME: This "is one of" information should become part of the function ;; declamation, not just a doc string @@ -1568,7 +1569,7 @@ (defun assign-minimal-var-names (vars) (declare (simple-vector vars)) (let* ((len (length vars)) - (width (length (format nil "~D" (1- len))))) + (width (length (format nil "~W" (1- len))))) (dotimes (i len) (setf (compiled-debug-var-symbol (svref vars i)) (intern (format nil "ARG-~V,'0D" width i) @@ -1627,18 +1628,6 @@ save-sc-offset) buffer))))))) -;;;; unpacking minimal debug functions - -;;; Return a FUN-MAP for a given COMPILED-DEBUG-INFO object. -(defun get-debug-info-fun-map (info) - (declare (type sb!c::compiled-debug-info info)) - (let ((map (sb!c::compiled-debug-info-fun-map info))) - ;; The old CMU CL had various hairy possibilities here, but in - ;; SBCL we only use this one, right? - (aver (simple-vector-p map)) - ;; So it's easy.. - map)) - ;;;; CODE-LOCATIONs ;;; If we're sure of whether code-location is known, return T or NIL. @@ -1735,7 +1724,7 @@ (car sources) (do ((prev sources src) (src (cdr sources) (cdr src)) - (offset (code-location-top-level-form-offset code-location))) + (offset (code-location-toplevel-form-offset code-location))) ((null src) (car prev)) (when (< offset (sb!c::debug-source-source-root (car src))) (return (car prev))))))) @@ -1743,11 +1732,11 @@ ;; did special tricks to debug the IR1 interpreter.) )) -;;; Returns the number of top-level forms before the one containing +;;; Returns the number of top level forms before the one containing ;;; CODE-LOCATION as seen by the compiler in some compilation unit. (A ;;; compilation unit is not necessarily a single file, see the section ;;; on debug-sources.) -(defun code-location-top-level-form-offset (code-location) +(defun code-location-toplevel-form-offset (code-location) (when (code-location-unknown-p code-location) (error 'unknown-code-location :code-location code-location)) (let ((tlf-offset (code-location-%tlf-offset code-location))) @@ -1766,7 +1755,7 @@ (t tlf-offset)))) ;;; Return the number of the form corresponding to CODE-LOCATION. The -;;; form number is derived by a walking the subforms of a top-level +;;; form number is derived by a walking the subforms of a top level ;;; form in depth-first order. (defun code-location-form-number (code-location) (when (code-location-unknown-p code-location) @@ -1839,8 +1828,7 @@ ;; interpreter.) )) ;; (There used to be more cases back before sbcl-0.7.0,, - ;; when we did special tricks to debug the IR1 - ;; interpreter.) + ;; when we did special tricks to debug IR1-interpreted code.) )) (defun sub-compiled-code-location= (obj1 obj2) (= (compiled-code-location-pc obj1) @@ -1962,8 +1950,6 @@ ;;; GC, and might also arise in debug variable locations when ;;; those variables are invalid.) (defun make-valid-lisp-obj (val) - (/show0 "entering MAKE-VALID-LISP-OBJ, VAL=..") - #!+sb-show (/hexstr val) (if (or ;; fixnum (zerop (logand val 3)) @@ -2134,15 +2120,11 @@ #!+x86 (defun sub-access-debug-var-slot (fp sc-offset &optional escaped) (declare (type system-area-pointer fp)) - (/show0 "entering SUB-ACCESS-DEBUG-VAR-SLOT, FP,SC-OFFSET,ESCAPED=..") - (/hexstr fp) (/hexstr sc-offset) (/hexstr escaped) (macrolet ((with-escaped-value ((var) &body forms) `(if escaped (let ((,var (sb!vm:context-register escaped (sb!c:sc-offset-offset sc-offset)))) - (/show0 "in escaped case, ,VAR value=..") - (/hexstr ,var) ,@forms) :invalid-value-for-unescaped-register-storage)) (escaped-float-value (format) @@ -2160,72 +2142,54 @@ :invalid-value-for-unescaped-register-storage))) (ecase (sb!c:sc-offset-scn sc-offset) ((#.sb!vm:any-reg-sc-number #.sb!vm:descriptor-reg-sc-number) - (/show0 "case of ANY-REG-SC-NUMBER or DESCRIPTOR-REG-SC-NUMBER") (without-gcing (with-escaped-value (val) - (/show0 "VAL=..") - (/hexstr val) (make-valid-lisp-obj val)))) (#.sb!vm:base-char-reg-sc-number - (/show0 "case of BASE-CHAR-REG-SC-NUMBER") (with-escaped-value (val) (code-char val))) (#.sb!vm:sap-reg-sc-number - (/show0 "case of SAP-REG-SC-NUMBER") (with-escaped-value (val) (int-sap val))) (#.sb!vm:signed-reg-sc-number - (/show0 "case of SIGNED-REG-SC-NUMBER") (with-escaped-value (val) (if (logbitp (1- sb!vm:n-word-bits) val) (logior val (ash -1 sb!vm:n-word-bits)) val))) (#.sb!vm:unsigned-reg-sc-number - (/show0 "case of UNSIGNED-REG-SC-NUMBER") (with-escaped-value (val) val)) (#.sb!vm:single-reg-sc-number - (/show0 "case of SINGLE-REG-SC-NUMBER") (escaped-float-value single-float)) (#.sb!vm:double-reg-sc-number - (/show0 "case of DOUBLE-REG-SC-NUMBER") (escaped-float-value double-float)) #!+long-float (#.sb!vm:long-reg-sc-number - (/show0 "case of LONG-REG-SC-NUMBER") (escaped-float-value long-float)) (#.sb!vm:complex-single-reg-sc-number - (/show0 "case of COMPLEX-SINGLE-REG-SC-NUMBER") (escaped-complex-float-value single-float)) (#.sb!vm:complex-double-reg-sc-number - (/show0 "case of COMPLEX-DOUBLE-REG-SC-NUMBER") (escaped-complex-float-value double-float)) #!+long-float (#.sb!vm:complex-long-reg-sc-number - (/show0 "case of COMPLEX-LONG-REG-SC-NUMBER") (escaped-complex-float-value long-float)) (#.sb!vm:single-stack-sc-number - (/show0 "case of SINGLE-STACK-SC-NUMBER") (sap-ref-single fp (- (* (1+ (sb!c:sc-offset-offset sc-offset)) sb!vm:n-word-bytes)))) (#.sb!vm:double-stack-sc-number - (/show0 "case of DOUBLE-STACK-SC-NUMBER") (sap-ref-double fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2) sb!vm:n-word-bytes)))) #!+long-float (#.sb!vm:long-stack-sc-number - (/show0 "case of LONG-STACK-SC-NUMBER") (sap-ref-long fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 3) sb!vm:n-word-bytes)))) (#.sb!vm:complex-single-stack-sc-number - (/show0 "case of COMPLEX-STACK-SC-NUMBER") (complex (sap-ref-single fp (- (* (1+ (sb!c:sc-offset-offset sc-offset)) sb!vm:n-word-bytes))) (sap-ref-single fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2) sb!vm:n-word-bytes))))) (#.sb!vm:complex-double-stack-sc-number - (/show0 "case of COMPLEX-DOUBLE-STACK-SC-NUMBER") (complex (sap-ref-double fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 2) sb!vm:n-word-bytes))) @@ -2233,30 +2197,24 @@ sb!vm:n-word-bytes))))) #!+long-float (#.sb!vm:complex-long-stack-sc-number - (/show0 "case of COMPLEX-LONG-STACK-SC-NUMBER") (complex (sap-ref-long fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 3) sb!vm:n-word-bytes))) (sap-ref-long fp (- (* (+ (sb!c:sc-offset-offset sc-offset) 6) sb!vm:n-word-bytes))))) (#.sb!vm:control-stack-sc-number - (/show0 "case of CONTROL-STACK-SC-NUMBER") (stack-ref fp (sb!c:sc-offset-offset sc-offset))) (#.sb!vm:base-char-stack-sc-number - (/show0 "case of BASE-CHAR-STACK-SC-NUMBER") (code-char (sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset)) sb!vm:n-word-bytes))))) (#.sb!vm:unsigned-stack-sc-number - (/show0 "case of UNSIGNED-STACK-SC-NUMBER") (sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset)) sb!vm:n-word-bytes)))) (#.sb!vm:signed-stack-sc-number - (/show0 "case of SIGNED-STACK-SC-NUMBER") (signed-sap-ref-32 fp (- (* (1+ (sb!c:sc-offset-offset sc-offset)) sb!vm:n-word-bytes)))) (#.sb!vm:sap-stack-sc-number - (/show0 "case of SAP-STACK-SC-NUMBER") (sap-ref-sap fp (- (* (1+ (sb!c:sc-offset-offset sc-offset)) sb!vm:n-word-bytes))))))) @@ -2547,8 +2505,8 @@ ;;; this to determine if the value stored is the actual value or an ;;; indirection cell. (defun indirect-value-cell-p (x) - (and (= (get-lowtag x) sb!vm:other-pointer-lowtag) - (= (get-type x) sb!vm:value-cell-header-widetag))) + (and (= (lowtag-of x) sb!vm:other-pointer-lowtag) + (= (widetag-of x) sb!vm:value-cell-header-widetag))) ;;; Return three values reflecting the validity of DEBUG-VAR's value ;;; at BASIC-CODE-LOCATION: @@ -2602,15 +2560,15 @@ ;;; This code produces and uses what we call source-paths. A ;;; source-path is a list whose first element is a form number as ;;; returned by CODE-LOCATION-FORM-NUMBER and whose last element is a -;;; top-level-form number as returned by -;;; CODE-LOCATION-TOP-LEVEL-FORM-NUMBER. The elements from the last to +;;; top level form number as returned by +;;; CODE-LOCATION-TOPLEVEL-FORM-NUMBER. The elements from the last to ;;; the first, exclusively, are the numbered subforms into which to ;;; descend. For example: ;;; (defun foo (x) ;;; (let ((a (aref x 3))) ;;; (cons a 3))) ;;; The call to AREF in this example is form number 5. Assuming this -;;; DEFUN is the 11'th top-level-form, the source-path for the AREF +;;; DEFUN is the 11'th top level form, the source-path for the AREF ;;; call is as follows: ;;; (5 1 0 1 3 11) ;;; Given the DEFUN, 3 gets you the LET, 1 gets you the bindings, 0 @@ -2623,13 +2581,13 @@ ;;; table used to detect CAR circularities in FORM-NUMBER-TRANSLATIONS (defvar *form-number-circularity-table* (make-hash-table :test 'eq)) -;;; This returns a table mapping form numbers to source-paths. A source-path -;;; indicates a descent into the top-level-form form, going directly to the -;;; subform corressponding to the form number. +;;; This returns a table mapping form numbers to source-paths. A +;;; source-path indicates a descent into the TOPLEVEL-FORM form, +;;; going directly to the subform corressponding to the form number. ;;; ;;; The vector elements are in the same format as the compiler's ;;; NODE-SOURCE-PATH; that is, the first element is the form number and -;;; the last is the top-level-form number. +;;; the last is the TOPLEVEL-FORM number. (defun form-number-translations (form tlf-number) (clrhash *form-number-circularity-table*) (setf (fill-pointer *form-number-temp*) 0) @@ -2658,7 +2616,7 @@ (frob) (setq trail (cdr trail))))))) -;;; FORM is a top-level form, and path is a source-path into it. This +;;; FORM is a top level form, and path is a source-path into it. This ;;; returns the form indicated by the source-path. Context is the ;;; number of enclosing forms to return instead of directly returning ;;; the source-path form. When context is non-zero, the form returned @@ -3079,28 +3037,28 @@ ;;; returns the overwritten bits. You must call this in a context in ;;; which GC is disabled, so that Lisp doesn't move objects around ;;; that C is pointing to. -(sb!alien:def-alien-routine "breakpoint_install" sb!c-call:unsigned-long +(sb!alien:define-alien-routine "breakpoint_install" sb!c-call:unsigned-long (code-obj sb!c-call:unsigned-long) (pc-offset sb!c-call:int)) ;;; This removes the break instruction and replaces the original ;;; instruction. You must call this in a context in which GC is disabled ;;; so Lisp doesn't move objects around that C is pointing to. -(sb!alien:def-alien-routine "breakpoint_remove" sb!c-call:void +(sb!alien:define-alien-routine "breakpoint_remove" sb!c-call:void (code-obj sb!c-call:unsigned-long) (pc-offset sb!c-call:int) (old-inst sb!c-call:unsigned-long)) -(sb!alien:def-alien-routine "breakpoint_do_displaced_inst" sb!c-call:void +(sb!alien:define-alien-routine "breakpoint_do_displaced_inst" sb!c-call:void (scp (* os-context-t)) (orig-inst sb!c-call:unsigned-long)) ;;;; breakpoint handlers (layer between C and exported interface) -;;; This maps components to a mapping of offsets to breakpoint-datas. +;;; This maps components to a mapping of offsets to BREAKPOINT-DATAs. (defvar *component-breakpoint-offsets* (make-hash-table :test 'eq)) -;;; This returns the breakpoint-data associated with component cross +;;; This returns the BREAKPOINT-DATA object associated with component cross ;;; offset. If none exists, this makes one, installs it, and returns it. (defun breakpoint-data (component offset &optional (create t)) (flet ((install-breakpoint-data () @@ -3118,7 +3076,7 @@ (install-breakpoint-data))))) ;;; We use this when there are no longer any active breakpoints -;;; corresponding to data. +;;; corresponding to DATA. (defun delete-breakpoint-data (data) (let* ((component (breakpoint-data-component data)) (offsets (delete (breakpoint-data-offset data) @@ -3130,10 +3088,10 @@ (values)) ;;; The C handler for interrupts calls this when it has a -;;; debugging-tool break instruction. This does NOT handle all breaks; -;;; for example, it does not handle breaks for internal errors. +;;; debugging-tool break instruction. This does *not* handle all +;;; breaks; for example, it does not handle breaks for internal +;;; errors. (defun handle-breakpoint (offset component signal-context) - (/show0 "entering HANDLE-BREAKPOINT") (let ((data (breakpoint-data component offset nil))) (unless data (error "unknown breakpoint in ~S at offset ~S" @@ -3157,7 +3115,6 @@ ;;; This handles code-location and DEBUG-FUN :FUN-START ;;; breakpoints. (defun handle-breakpoint-aux (breakpoints data offset component signal-context) - (/show0 "entering HANDLE-BREAKPOINT-AUX") (unless breakpoints (error "internal error: breakpoint that nobody wants")) (unless (member data *executing-breakpoint-hooks*) @@ -3202,7 +3159,6 @@ bpt))))) (defun handle-fun-end-breakpoint (offset component context) - (/show0 "entering HANDLE-FUN-END-BREAKPOINT") (let ((data (breakpoint-data component offset nil))) (unless data (error "unknown breakpoint in ~S at offset ~S" @@ -3217,7 +3173,6 @@ ;;; [old C code] or HANDLE-FUN-END-BREAKPOINT calls this directly ;;; [new C code]. (defun handle-fun-end-breakpoint-aux (breakpoints data signal-context) - (/show0 "entering HANDLE-FUN-END-BREAKPOINT-AUX") (delete-breakpoint-data data) (let* ((scp (locally @@ -3333,7 +3288,7 @@ (do-debug-fun-blocks (block debug-fun) (do-debug-block-locations (loc block) (fill-in-code-location loc) - (format t "~S code location at ~D" + (format t "~S code location at ~W" (compiled-code-location-kind loc) (compiled-code-location-pc loc)) (sb!debug::print-code-location-source-form loc 0)