[Sbcl-commits] master: factor debug-name cleaning into a separate function

[Nikodemus S. <de...@us...>]

The branch "master" has been updated in SBCL:
       via  a2fd28fb6d0b3d8d230a7c933db352f80891ac1c (commit)
      from  bb9b382751d808c76592ce2484c33f8447db6568 (commit)

- Log -----------------------------------------------------------------
commit a2fd28fb6d0b3d8d230a7c933db352f80891ac1c
Author: Nikodemus Siivola <nik...@ra...>
Date:   Sat May 19 15:28:41 2012 +0300

    factor debug-name cleaning into a separate function
    
      We will need it elsewhere too.
---
 src/code/debug.lisp |   41 ++++++++++++++++++++---------------------
 1 files changed, 20 insertions(+), 21 deletions(-)

diff --git a/src/code/debug.lisp b/src/code/debug.lisp
index 9a9db8b..2558ba3 100644
--- a/src/code/debug.lisp
+++ b/src/code/debug.lisp
@@ -361,29 +361,28 @@ thread, NIL otherwise."
                       (make-unprintable-object "more unavailable arguments")))))
               args)))
 
+(defun clean-debug-fun-name (name &optional args)
+  ;; FIXME: do we need to deal with
+  ;; HAIRY-FUNCTION-ENTRY here? I can't make it or
+  ;; &AUX-BINDINGS appear in backtraces, so they are
+  ;; left alone for now. --NS 2005-02-28
+  (if (consp name)
+      (case (first name)
+        ((sb!c::xep sb!c::tl-xep)
+         (clean-xep name args))
+        ((sb!c::&more-processor)
+         (clean-&more-processor name args))
+        ((sb!c::hairy-arg-processor
+          sb!c::varargs-entry sb!c::&optional-processor)
+         (clean-debug-fun-name (second name) args))
+        (t
+         (values name args)))
+      (values name args)))
+
 (defun frame-call (frame)
   (labels ((clean-name-and-args (name args)
-             (if (and (consp name) (not *show-entry-point-details*))
-                 ;; FIXME: do we need to deal with
-                 ;; HAIRY-FUNCTION-ENTRY here? I can't make it or
-                 ;; &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)
-                    (clean-&more-processor name args))
-                   ((sb!c::hairy-arg-processor
-                     sb!c::varargs-entry sb!c::&optional-processor)
-                    (clean-name-and-args (second name) args))
-                   (t
-                    (values name args)))
+             (if (not *show-entry-point-details*)
+                 (clean-debug-fun-name name args)
                  (values name args))))
     (let ((debug-fun (sb!di:frame-debug-fun frame)))
       (multiple-value-bind (name args)

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL