X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug.lisp;h=adc28e09d3877f3625c6786066c5472d13f119f4;hb=4d0b87793a047baecf2403455ddca1a82f44a41b;hp=ec41b0dac2d1b4e75f9a8a2c9d72819468078e03;hpb=cff4add8f008056edf4c876260c6be8ba804b24c;p=sbcl.git

diff --git a/src/code/debug.lisp b/src/code/debug.lisp
index ec41b0d..adc28e0 100644
--- a/src/code/debug.lisp
+++ b/src/code/debug.lisp
@@ -247,6 +247,7 @@ thread, NIL otherwise."
                                               optional
                                               rest
                                               keyword
+                                              more
                                               deleted)
   `(etypecase ,element
      (sb!di:debug-var
@@ -255,7 +256,8 @@ thread, NIL otherwise."
       (ecase (car ,element)
         (:optional ,@optional)
         (:rest ,@rest)
-        (:keyword ,@keyword)))
+        (:keyword ,@keyword)
+        (:more ,@more)))
      (symbol
       (aver (eq ,element :deleted))
       ,@deleted)))
@@ -301,7 +303,19 @@ thread, NIL otherwise."
                           (return-from enumerating))
                         (push (make-unprintable-object
                                "unavailable &REST argument")
-                              reversed-result)))))
+                              reversed-result)))
+              :more ((lambda-var-dispatch (second element) location
+                         nil
+                         (let ((context (sb!di:debug-var-value (second element) frame))
+                               (count (sb!di:debug-var-value (third element) frame)))
+                           (setf reversed-result
+                                 (append (reverse
+                                          (multiple-value-list
+                                           (sb!c::%more-arg-values context 0 count)))
+                                         reversed-result))
+                           (return-from enumerating))
+                         (push (make-unprintable-object "unavailable &MORE argument")
+                               reversed-result)))))
            frame))
         (nreverse reversed-result))
     (sb!di:lambda-list-unavailable ()
@@ -343,6 +357,12 @@ thread, NIL otherwise."
                  ;; &AUX-BINDINGS appear in backtraces, so they are
                  ;; left alone for now. --NS 2005-02-28
                  (case (first name)
+                   ((eval)
+                    ;; The name of an evaluator thunk contains
+                    ;; the source context -- but that makes for a
+                    ;; confusing frame name, since it can look like an
+                    ;; EVAL call with a bogus argument.
+                    (values '#:eval-thunk nil))
                    ((sb!c::xep sb!c::tl-xep)
                     (clean-xep name args))
                    ((sb!c::&more-processor)
@@ -397,10 +417,17 @@ thread, NIL otherwise."
           ;; If we hit a &REST arg, then print as many of the values as
           ;; possible, punting the loop over lambda-list variables since any
           ;; other arguments will be in the &REST arg's list of values.
-          (let ((args (ensure-printable-object args)))
-            (if (listp args)
-                (format stream "~{ ~_~S~}" args)
-                (format stream " ~S" args))))
+          (let ((print-args (ensure-printable-object args))
+                ;; Special case *PRINT-PRETTY* for eval frames: if
+                ;; *PRINT-LINES* is 1, turn off pretty-printing.
+                (*print-pretty*
+                 (if (and (eql 1 *print-lines*)
+                          (member name '(eval simple-eval-in-lexenv)))
+                     nil
+                     *print-pretty*)))
+            (if (listp print-args)
+                (format stream "~{ ~_~S~}" print-args)
+                (format stream " ~S" print-args))))
         (when kind
           (format stream "[~S]" kind))))
   (when (>= verbosity 2)