Changeset 11134


Ignore:
Timestamp:
Oct 17, 2008, 1:23:47 PM (11 years ago)
Author:
gz
Message:

From working-0711 branch: show all supplied args in backtrace.

File:
1 edited

Legend:

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

    r10228 r11134  
    2828(defparameter *backtrace-print-length* 5)
    2929
    30 (defparameter *backtrace-format* :traditional
     30(defparameter *backtrace-format* #+ccl-0711 :direct #-ccl-0711 :traditional
    3131  "If :TRADITIONAL, shows calls to non-toplevel functions using FUNCALL, and shows frame address values.
    3232   If :DIRECT, uses a more streamlined format.")
     
    167167             (case *backtrace-format*
    168168               (:direct
    169                   (list (format nil "~s" lfun)))
     169                  (list (format nil "~s" (or name lfun))))
    170170               (:list
    171                   (if (lfun-closure-p lfun) ;; could be stack consed
    172                     (list 'funcall (format nil "~s" lfun))
    173                     (list lfun)))
     171                  (list 'funcall (format nil "~s" (or name lfun))))
    174172               (t (list 'funcall `(function ,(concatenate 'string "#<" (%lfun-name-string lfun) ">")))))))
    175          (if (and pc (<= pc target::arg-check-trap-pc-limit))
    176            (arg-check-call-arguments cfp lfun)
    177            (collect ((call))
    178              (multiple-value-bind (req opt restp keys)
    179                  (function-args lfun)
    180                (when (or (not (eql 0 req)) (not (eql 0 opt)) restp keys)
    181                  (let* ((arglist (arglist-from-map lfun)))
    182                    (if (or (null arglist) (null pc))
    183                      (call "???")
    184                      (progn
    185                        (dotimes (i req)
    186                          (let* ((val (argument-value context cfp lfun pc (pop arglist))))
    187                            (if (eq val (%unbound-marker))
    188                              (call "?")
    189                              (call (let* ((*print-length* *backtrace-print-length*)
    190                                           (*print-level* *backtrace-print-level*))
    191                                      (format nil "~s" val))))))
    192                        (case *backtrace-format*
    193                          (:direct
    194                             (when (not (eql opt 0)) (call "[&optional ...]"))
    195                             (if keys
    196                               (call "[&key ...]")
    197                               (when restp (call "[&rest ...]"))))
    198                          (t (if (or restp keys (not (eql opt 0)))
    199                               (call "[...]"))))))))
    200                (call))))))
     173         (backtrace-supplied-args context cfp lfun pc)))
     174
     175(defun backtrace-supplied-args (context frame lfun pc)
     176  (if (and pc (<= pc target::arg-check-trap-pc-limit))
     177    (arg-check-call-arguments frame lfun)
     178    (multiple-value-bind (params valid) (arglist-from-map lfun)
     179      (if (not valid)
     180        '("???")
     181        (let ((args (arguments-and-locals context frame lfun pc)) ;overkill, but will do.
     182              (state :required)
     183              (strings ()))
     184          (flet ((collect (arg)
     185                   (let* ((*print-length* *backtrace-print-length*)
     186                          (*print-level* *backtrace-print-level*))
     187                     (push (format nil "~s" arg) strings))))
     188            (dolist (param params)
     189              (if (or (member param lambda-list-keywords) (eq param '&lexpr))
     190                (setq state param)
     191                (let* ((pair (pop args))
     192                       (value (cdr pair)))
     193                  (case state
     194                    (&lexpr
     195                       (with-list-from-lexpr (rest value)
     196                         (dolist (r rest) (collect r)))
     197                       (return))
     198                    (&rest
     199                       (dolist (r value) (collect r))
     200                       (return))
     201                    (&key (collect param)))
     202                  (if (eq value (%unbound-marker))
     203                    (push "?" strings)
     204                    (collect value))))))
     205          (nreverse strings))))))
    201206
    202207;;; Return a list of "interesting" frame addresses in context, most
Note: See TracChangeset for help on using the changeset viewer.