[slime-cvs] CVS slime

[CVS User sboukarev]

Update of /project/slime/cvsroot/slime
In directory tiger.common-lisp.net:/tmp/cvs-serv24228

Modified Files:
	ChangeLog swank-sbcl.lisp 
Log Message:
* swank-sbcl.lisp (call-with-debugging-environment): Use
sb-debug::resolve-stack-top-hint instead of just
sb-debug:*stack-top-hint*, because now it can contain things other
than just frames.


--- /project/slime/cvsroot/slime/ChangeLog	2012/07/13 13:52:45	1.2345
+++ /project/slime/cvsroot/slime/ChangeLog	2012/08/04 23:32:37	1.2346
@@ -1,3 +1,10 @@
+2012-08-04  Stas Boukarev  <stassats at gmail.com>
+
+	* swank-sbcl.lisp (call-with-debugging-environment): Use
+	sb-debug::resolve-stack-top-hint instead of just
+	sb-debug:*stack-top-hint*, because now it can contain things other
+	than just frames.
+
 2012-07-13  Helmut Eller  <heller at common-lisp.net>
 
 	* slime.el: Don't compile functions that are now in other files.
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2012/05/12 06:34:47	1.322
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2012/08/04 23:32:37	1.323
@@ -1069,16 +1069,19 @@
 
 (defimplementation call-with-debugging-environment (debugger-loop-fn)
   (declare (type function debugger-loop-fn))
-  (let* ((*sldb-stack-top* (if *debug-swank-backend*
-                               (sb-di:top-frame)
-                               (or sb-debug:*stack-top-hint*
-                                   (sb-di:top-frame))))
-         (sb-debug:*stack-top-hint* nil))
+  (let ((*sldb-stack-top*
+          (if (and (not *debug-swank-backend*)
+                   sb-debug:*stack-top-hint*)
+              #+#.(swank-backend:with-symbol 'resolve-stack-top-hint 'sb-debug)
+              (sb-debug::resolve-stack-top-hint)
+              #-#.(swank-backend:with-symbol 'resolve-stack-top-hint 'sb-debug)
+              sb-debug:*stack-top-hint*
+              (sb-di:top-frame)))
+        (sb-debug:*stack-top-hint* nil))
     (handler-bind ((sb-di:debug-condition
-		    (lambda (condition)
-                      (signal (make-condition
-                               'sldb-condition
-                               :original-condition condition)))))
+                     (lambda (condition)
+                       (signal 'sldb-condition
+                               :original-condition condition))))
       (funcall debugger-loop-fn))))
 
 #+#.(swank-backend::sbcl-with-new-stepper-p)