Changeset 7594


Ignore:
Timestamp:
Nov 5, 2007, 6:11:56 AM (13 years ago)
Author:
gz
Message:

Make %show-stack-frame and %show-args-and-locals catch errors. This makes it possible to see the rest of the backtrace even if a particular frame craps out.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/lib/backtrace.lisp

    r7368 r7594  
    4848
    4949(defun %show-stack-frame (p context lfun pc)
    50   (multiple-value-bind (count vsp parent-vsp) (count-values-in-frame p context)
    51     (declare (fixnum count))
    52     (dotimes (i count)
    53       (multiple-value-bind (var type name)
    54           (nth-value-in-frame p i context lfun pc vsp parent-vsp)
    55         (format t "~&  ~D " i)
    56         (when name (format t "~s" name))
    57         (let* ((*print-length* *backtrace-print-length*)
    58                (*print-level* *backtrace-print-level*))
    59           (format t ": ~s" var))
    60         (when type (format t " (~S)" type)))))
     50  (handler-case
     51      (multiple-value-bind (count vsp parent-vsp) (count-values-in-frame p context)
     52        (declare (fixnum count))
     53        (dotimes (i count)
     54          (multiple-value-bind (var type name)
     55                               (nth-value-in-frame p i context lfun pc vsp parent-vsp)
     56            (format t "~&  ~D " i)
     57            (when name (format t "~s" name))
     58            (let* ((*print-length* *backtrace-print-length*)
     59                   (*print-level* *backtrace-print-level*))
     60              (format t ": ~s" var))
     61            (when type (format t " (~S)" type)))))
     62    (error () (format t "#<error printing frame>")))
    6163  (terpri)
    6264  (terpri))
    6365
    6466(defun %show-args-and-locals (p context lfun pc)
    65   (let* ((unavailable (cons nil nil)))
    66     (multiple-value-bind (args locals) (arguments-and-locals context p lfun pc unavailable)
    67       (format t "~&  ~s" (arglist-from-map lfun))
    68       (let* ((*print-length* *backtrace-print-length*)
    69              (*print-level* *backtrace-print-level*))
    70         (flet ((show-pair (pair prefix)
    71                  (destructuring-bind (name . val) pair
    72                    (format t "~&~a~s: " prefix name)
    73                    (if (eq val unavailable)
    74                      (format t "#<Unavailable>")
    75                      (format t "~s" val)))))
    76           (dolist (arg args)
    77             (show-pair arg "   "))
    78           (terpri)
    79           (terpri)
    80           (dolist (loc locals)
    81             (show-pair loc "  "))
    82           (terpri)
    83           (terpri))))))
     67  (handler-case
     68      (let* ((unavailable (cons nil nil)))
     69        (multiple-value-bind (args locals) (arguments-and-locals context p lfun pc unavailable)
     70          (format t "~&  ~s" (arglist-from-map lfun))
     71          (let* ((*print-length* *backtrace-print-length*)
     72                 (*print-level* *backtrace-print-level*))
     73            (flet ((show-pair (pair prefix)
     74                     (destructuring-bind (name . val) pair
     75                       (format t "~&~a~s: " prefix name)
     76                       (if (eq val unavailable)
     77                         (format t "#<Unavailable>")
     78                         (format t "~s" val)))))
     79              (dolist (arg args)
     80                (show-pair arg "   "))
     81              (terpri)
     82              (terpri)
     83              (dolist (loc locals)
     84                (show-pair loc "  "))))))
     85    (error () (format t "#<error printing args and locals>")))
     86  (terpri)
     87  (terpri))
    8488
    8589
Note: See TracChangeset for help on using the changeset viewer.