Changeset 8025

Timestamp:

Jan 8, 2008, 12:47:57 AM (17 years ago)

Author:

Gary Byers

Message:

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

File:

• branches/working-0711/ccl/lib/backtrace.lisp (modified) (2 diffs)

branches/working-0711/ccl/lib/backtrace.lisp

@@ -96 +96 @@
           (call 'funcall)
           (call `(function ,(concatenate 'string "#<" (%lfun-name-string lfun) ">")))))
-      (multiple-value-bind (req opt restp keys)
-          (function-args lfun)
-        (when (or (not (eql 0 req)) (not (eql 0 opt)) restp keys)
-          (let* ((arglist (arglist-from-map lfun)))
-            (if (null arglist)
-              (call "???")
-              (progn
-                (dotimes (i req)
-                  (let* ((val (argument-value context cfp lfun pc (pop arglist))))
-                    (if (eq val (%unbound-marker))
-                      (call "?")
-                      (call (let* ((*print-length* *backtrace-print-length*)
-                                   (*print-level* *backtrace-print-level*))
-                              (format nil "~s" val))))))
-                (if (or restp keys (not (eql opt 0)))
-                  (call "[...]"))
-                ))))))
-    (call)))
+      (if (<= pc target::arg-check-trap-pc-limit)
+        (append (call) (arg-check-call-arguments cfp lfun))
+        (multiple-value-bind (req opt restp keys)
+            (function-args lfun)
+          (when (or (not (eql 0 req)) (not (eql 0 opt)) restp keys)
+            (let* ((arglist (arglist-from-map lfun)))
+              (if (null arglist)
+                (call "???")
+                (progn
+                  (dotimes (i req)
+                    (let* ((val (argument-value context cfp lfun pc (pop arglist))))
+                      (if (eq val (%unbound-marker))
+                        (call "?")
+                        (call (let* ((*print-length* *backtrace-print-length*)
+                                     (*print-level* *backtrace-print-level*))
+                                (format nil "~s" val))))))
+                  (if (or restp keys (not (eql opt 0)))
+                    (call "[...]"))))))
+          (call))))))
 
 
@@ -150 +151 @@
             (unless (and (typep detailed-p 'fixnum)
                          (not (= (the fixnum detailed-p) frame-number)))
-              (format t "~&(~x) : ~D ~a ~d"
+              (format t "~&~c(~x) : ~D ~a ~d"
+                      (let* ((q (parent-frame p context)))
+                        (if (and q (exception-frame-p q)) #\- #\space))
                       (index->address p) frame-number
                       (if lfun (backtrace-call-arguments context p lfun pc))