X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug-int.lisp;h=a7856e97bb7e116e0aa34515c6cdf00aa1ab3b8e;hb=212ef8043aeaceaa627f2924e04554fbc37b8ee1;hp=a4d95df3a7f9c1400108cfe373beefb2ba8d4cef;hpb=7f76d571fe545578e3bd26e627d181a39a8f1eb7;p=sbcl.git diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index a4d95df..a7856e9 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -38,24 +38,27 @@ () #!+sb-doc (:documentation - "All debug-conditions inherit from this type. These are serious conditions + "All DEBUG-CONDITIONs inherit from this type. These are serious conditions that must be handled, but they are not programmer errors.")) (define-condition no-debug-info (debug-condition) - () + ((code-component :reader no-debug-info-code-component + :initarg :code-component)) #!+sb-doc - (:documentation "There is absolutely no debugging information available.") + (:documentation "There is no usable debugging information available.") (:report (lambda (condition stream) (declare (ignore condition)) (fresh-line stream) - (write-line "No debugging information available." stream)))) + (format stream + "no debug information available for ~S~%" + (no-debug-info-code-component condition))))) (define-condition no-debug-function-returns (debug-condition) ((debug-function :reader no-debug-function-returns-debug-function :initarg :debug-function)) #!+sb-doc (:documentation - "The system could not return values from a frame with debug-function since + "The system could not return values from a frame with DEBUG-FUNCTION since it lacked information about returning values.") (:report (lambda (condition stream) (let ((fun (debug-function-function @@ -127,11 +130,11 @@ "All programmer errors from using the interface for building debugging tools inherit from this type.")) -(define-condition unhandled-condition (debug-error) - ((condition :reader unhandled-condition-condition :initarg :condition)) +(define-condition unhandled-debug-condition (debug-error) + ((condition :reader unhandled-debug-condition-condition :initarg :condition)) (:report (lambda (condition stream) (format stream "~&unhandled DEBUG-CONDITION:~%~A" - (unhandled-condition-condition condition))))) + (unhandled-debug-condition-condition condition))))) (define-condition unknown-code-location (debug-error) ((code-location :reader unknown-code-location-code-location @@ -162,20 +165,21 @@ (frame :reader frame-function-mismatch-frame :initarg :frame) (form :reader frame-function-mismatch-form :initarg :form)) (:report (lambda (condition stream) - (format stream - "~&Form was preprocessed for ~S,~% but called on ~S:~% ~S" - (frame-function-mismatch-code-location condition) - (frame-function-mismatch-frame condition) - (frame-function-mismatch-form condition))))) - -;;; This signals debug-conditions. If they go unhandled, then signal an -;;; unhandled-condition error. + (format + stream + "~&Form was preprocessed for ~S,~% but called on ~S:~% ~S" + (frame-function-mismatch-code-location condition) + (frame-function-mismatch-frame condition) + (frame-function-mismatch-form condition))))) + +;;; This signals debug-conditions. If they go unhandled, then signal +;;; an UNHANDLED-DEBUG-CONDITION error. ;;; ;;; ??? Get SIGNAL in the right package! (defmacro debug-signal (datum &rest arguments) `(let ((condition (make-condition ,datum ,@arguments))) (signal condition) - (error 'unhandled-condition :condition condition))) + (error 'unhandled-debug-condition :condition condition))) ;;;; structures ;;;; @@ -1108,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) @@ -1123,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 @@ -1187,7 +1192,7 @@ (let ((info (%code-debug-info component))) (cond ((not info) - (debug-signal 'no-debug-info)) + (debug-signal 'no-debug-info :code-component component)) ((eq info :bogus-lra) (make-bogus-debug-function "function end breakpoint")) (t @@ -1200,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 @@ -1809,7 +1813,7 @@ (let* ((locations (dotimes (k (sb!c::read-var-integer blocks i) (result locations-buffer)) - (let ((kind (svref sb!c::compiled-code-location-kinds + (let ((kind (svref sb!c::*compiled-code-location-kinds* (aref+ blocks i))) (pc (+ last-pc (sb!c::read-var-integer blocks i))) @@ -1999,7 +2003,7 @@ (if (logtest flags sb!c::minimal-debug-function-setf-bit) `(setf ,base) base)) - :kind (svref sb!c::minimal-debug-function-kinds + :kind (svref sb!c::*minimal-debug-function-kinds* (ldb sb!c::minimal-debug-function-kind-byte options)) :variables (when vars-p @@ -3618,7 +3622,7 @@ #!+x86 sb!vm::ebx-offset))) (nargs (make-lisp-obj (sb!vm:context-register scp sb!vm::nargs-offset))) - (reg-arg-offsets '#.sb!vm::register-arg-offsets) + (reg-arg-offsets '#.sb!vm::*register-arg-offsets*) (results nil)) (without-gcing (dotimes (arg-num nargs) @@ -3629,7 +3633,7 @@ results))) (nreverse results))) -;;;; MAKE-BOGUS-LRA (used for :function-end breakpoints) +;;;; MAKE-BOGUS-LRA (used for :FUNCTION-END breakpoints) (defconstant bogus-lra-constants