Changeset 8025


Ignore:
Timestamp:
Jan 8, 2008, 8:47:57 AM (12 years ago)
Author:
gb
Message:

BACKTRACE-CALL-ARGUMENTS: try to show real arguments if before #args
trap.

File:
1 edited

Legend:

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

    r7624 r8025  
    9696          (call 'funcall)
    9797          (call `(function ,(concatenate 'string "#<" (%lfun-name-string lfun) ">")))))
    98       (multiple-value-bind (req opt restp keys)
    99           (function-args lfun)
    100         (when (or (not (eql 0 req)) (not (eql 0 opt)) restp keys)
    101           (let* ((arglist (arglist-from-map lfun)))
    102             (if (null arglist)
    103               (call "???")
    104               (progn
    105                 (dotimes (i req)
    106                   (let* ((val (argument-value context cfp lfun pc (pop arglist))))
    107                     (if (eq val (%unbound-marker))
    108                       (call "?")
    109                       (call (let* ((*print-length* *backtrace-print-length*)
    110                                    (*print-level* *backtrace-print-level*))
    111                               (format nil "~s" val))))))
    112                 (if (or restp keys (not (eql opt 0)))
    113                   (call "[...]"))
    114                 ))))))
    115     (call)))
     98      (if (<= pc target::arg-check-trap-pc-limit)
     99        (append (call) (arg-check-call-arguments cfp lfun))
     100        (multiple-value-bind (req opt restp keys)
     101            (function-args lfun)
     102          (when (or (not (eql 0 req)) (not (eql 0 opt)) restp keys)
     103            (let* ((arglist (arglist-from-map lfun)))
     104              (if (null arglist)
     105                (call "???")
     106                (progn
     107                  (dotimes (i req)
     108                    (let* ((val (argument-value context cfp lfun pc (pop arglist))))
     109                      (if (eq val (%unbound-marker))
     110                        (call "?")
     111                        (call (let* ((*print-length* *backtrace-print-length*)
     112                                     (*print-level* *backtrace-print-level*))
     113                                (format nil "~s" val))))))
     114                  (if (or restp keys (not (eql opt 0)))
     115                    (call "[...]"))))))
     116          (call))))))
    116117
    117118
     
    150151            (unless (and (typep detailed-p 'fixnum)
    151152                         (not (= (the fixnum detailed-p) frame-number)))
    152               (format t "~&(~x) : ~D ~a ~d"
     153              (format t "~&~c(~x) : ~D ~a ~d"
     154                      (let* ((q (parent-frame p context)))
     155                        (if (and q (exception-frame-p q)) #\- #\space))
    153156                      (index->address p) frame-number
    154157                      (if lfun (backtrace-call-arguments context p lfun pc))
Note: See TracChangeset for help on using the changeset viewer.