/[slime]/slime/swank-cmucl.lisp
ViewVC logotype

Diff of /slime/swank-cmucl.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.136 by heller, Thu Jan 13 23:17:02 2005 UTC revision 1.137 by heller, Wed Jan 19 18:27:47 2005 UTC
# Line 1727  A utility for debugging DEBUG-FUNCTION-A Line 1727  A utility for debugging DEBUG-FUNCTION-A
1727      (c::compiled-debug-function-returns cdfun)))      (c::compiled-debug-function-returns cdfun)))
1728    
1729  (define-condition breakpoint (simple-condition)  (define-condition breakpoint (simple-condition)
1730    ((message :initarg :message :reader breakpoint.message))    ((message :initarg :message :reader breakpoint.message)
1731       (values  :initarg :values  :reader breakpoint.values))
1732    (:report (lambda (c stream) (princ (breakpoint.message c) stream))))    (:report (lambda (c stream) (princ (breakpoint.message c) stream))))
1733    
1734  (defimplementation condition-extras ((c breakpoint))  (defimplementation condition-extras ((c breakpoint))
# Line 1737  A utility for debugging DEBUG-FUNCTION-A Line 1738  A utility for debugging DEBUG-FUNCTION-A
1738  (defun signal-breakpoint (breakpoint frame)  (defun signal-breakpoint (breakpoint frame)
1739    "Signal a breakpoint condition for BREAKPOINT in FRAME.    "Signal a breakpoint condition for BREAKPOINT in FRAME.
1740  Try to create a informative message."  Try to create a informative message."
1741    (flet ((brk (fstring &rest args)    (flet ((brk (values fstring &rest args)
1742             (let ((msg (apply #'format nil fstring args))             (let ((msg (apply #'format nil fstring args))
1743                   (debug:*stack-top-hint* frame))                   (debug:*stack-top-hint* frame))
1744               (break 'breakpoint :message msg))))               (break 'breakpoint :message msg :values values))))
1745    (with-struct (di::breakpoint- kind what) breakpoint      (with-struct (di::breakpoint- kind what) breakpoint
1746      (case kind        (case kind
1747        (:code-location          (:code-location
1748         (case (di:code-location-kind what)           (case (di:code-location-kind what)
1749           ((:single-value-return :known-return :unknown-return)             ((:single-value-return :known-return :unknown-return)
1750            (brk "Return value: ~{~S ~}" (breakpoint-values breakpoint)))              (let ((values (breakpoint-values breakpoint)))
1751           (t                (brk values "Return value: ~{~S ~}" values)))
1752            (brk "Breakpoint: ~S ~S"             (t
1753                 (di:code-location-kind what)              (brk nil "Breakpoint: ~S ~S"
1754                 (di::compiled-code-location-pc what)))))                   (di:code-location-kind what)
1755        (:function-start                   (di::compiled-code-location-pc what)))))
1756         (brk "Function start breakpoint"))          (:function-start
1757        (t (brk "Breakpoint: ~A in ~A" breakpoint frame))))))           (brk nil "Function start breakpoint"))
1758            (t (brk nil "Breakpoint: ~A in ~A" breakpoint frame))))))
1759    
1760  (defimplementation sldb-break-at-start (fname)  (defimplementation sldb-break-at-start (fname)
1761    (let ((debug-fun (di:function-debug-function (coerce fname 'function))))    (let ((debug-fun (di:function-debug-function (coerce fname 'function))))

Legend:
Removed from v.1.136  
changed lines
  Added in v.1.137

  ViewVC Help
Powered by ViewVC 1.1.5