From c325337271f3d5a1a1c1b5fe2bd009d7ab31b7ac Mon Sep 17 00:00:00 2001
From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Fri, 20 Apr 2012 00:06:20 +0300
Subject: [PATCH] show correct number of arguments for arg-count error frames

  Or at least pretend harder. Ie. if the frame is a XEP frame,
  and the actual argument count is > number of parsed arguments,
  make up unprintable ersatz objects for the rest.
---
 NEWS                    |    2 ++
 src/code/debug.lisp     |   15 +++++++++++----
 tests/debug.impure.lisp |    4 ++++
 3 files changed, 17 insertions(+), 4 deletions(-)

diff --git a/NEWS b/NEWS
index 678758b..92a7af6 100644
--- a/NEWS
+++ b/NEWS
@@ -3,6 +3,8 @@ changes relative to sbcl-1.0.56:
   * enhancement: GENCGC reclaims space more aggressively when objects being
     allocated are a large fraction of the total available heap space.
     (lp#936304)
+  * enhancement: backtraces show the correct number of arguments for frames
+    called with too many arguments.
   * optimization: fewer uses of full calls to signed modular functions.
     (lp#903821)
   * bug fix: fixed disassembly of some SSE instructions on x86-64.
diff --git a/src/code/debug.lisp b/src/code/debug.lisp
index 9852810..5190f3f 100644
--- a/src/code/debug.lisp
+++ b/src/code/debug.lisp
@@ -331,11 +331,18 @@ thread, NIL otherwise."
 (defun clean-xep (name args)
   (values (second name)
           (if (consp args)
-              (let ((count (first args))
-                    (real-args (rest args)))
+              (let* ((count (first args))
+                     (real-args (rest args)))
                 (if (fixnump count)
-                    (subseq real-args 0
-                            (min count (length real-args)))
+                    ;; So, this is a cheap trick -- but makes backtraces for
+                    ;; too-many-arguments-errors much, much easier to to
+                    ;; understand. FIXME: For :EXTERNAL frames at least we
+                    ;; should be able to get the actual arguments, really.
+                    (loop repeat count
+                          for arg = (if real-args
+                                        (pop real-args)
+                                        (make-unprintable-object "unknown"))
+                          collect arg)
                     real-args))
               args)))
 
diff --git a/tests/debug.impure.lisp b/tests/debug.impure.lisp
index 4d02466..208cbe8 100644
--- a/tests/debug.impure.lisp
+++ b/tests/debug.impure.lisp
@@ -251,6 +251,10 @@
 (defun oops ()
   (error "oops"))
 
+(with-test (:name :xep-too-many-arguments)
+  (assert (verify-backtrace (lambda () (oops 1 2 3 4 5 6))
+                            '((oops ? ? ? ? ? ?)))))
+
 (defmacro defbt (n ll &body body)
   `(progn
      ;; normal debug info
-- 
1.7.10.4