Changeset 9180


Ignore:
Timestamp:
Apr 18, 2008, 1:12:25 PM (11 years ago)
Author:
gz
Message:

Show all supplied args in backtrace. Display method names as (method name specialisers).

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/lib/backtrace.lisp

    r8979 r9180  
    167167             (case *backtrace-format*
    168168               (:direct
    169                   (list (format nil "~s" lfun)))
     169                  (when (and (consp name) (typep lfun 'method-function))
     170                    (setq name `(method ,@name)))
     171                  (list (format nil "~s" (or name lfun))))
    170172               (:list
    171                   (if t ;(lfun-closure-p lfun) ;; could be stack consed
    172                     (list 'funcall (format nil "~s" lfun))
    173                     (list lfun)))
     173                  (list 'funcall (format nil "~s" (or name lfun))))
    174174               (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))))))
     175         (backtrace-supplied-args context cfp lfun pc)))
     176
     177
     178(defun backtrace-supplied-args (context frame lfun pc)
     179  (if (and pc (<= pc target::arg-check-trap-pc-limit))
     180    (arg-check-call-arguments frame lfun)
     181    (multiple-value-bind (params valid) (arglist-from-map lfun)
     182      (if (not valid)
     183        '("???")
     184        (let ((args (arguments-and-locals context frame lfun pc)) ;overkill, but will do.
     185              (state :required)
     186              (strings ()))
     187          (flet ((collect (arg)
     188                   (let* ((*print-length* *backtrace-print-length*)
     189                          (*print-level* *backtrace-print-level*))
     190                     (push (format nil "~s" arg) strings))))
     191            (dolist (param params)
     192              (if (or (member param lambda-list-keywords) (eq param '&lexpr))
     193                (setq state param)
     194                (let* ((pair (pop args))
     195                       (value (cdr pair)))
     196                  (case state
     197                    (&lexpr
     198                       (with-list-from-lexpr (rest value)
     199                         (dolist (r rest) (collect r)))
     200                       (return))
     201                    (&rest
     202                       (dolist (r value) (collect r))
     203                       (return))
     204                    (&key (collect param)))
     205                  (if (eq value (%unbound-marker))
     206                    (push "?" strings)
     207                    (collect value))))))
     208          (nreverse strings))))))
     209
     210
     211
    201212
    202213;;; Return a list of "interesting" frame addresses in context, most
Note: See TracChangeset for help on using the changeset viewer.