[slime-cvs] CVS slime

[CVS User mevenson]

Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv30441

Modified Files:
	swank-abcl.lisp ChangeLog 
Log Message:
* swank-abcl.lisp: Accommodate the new Java/Lisp stack frame
  		   abstraction in the upcoming abcl-0.16. (based on
  		   code from Tobias Rittweiler).


--- /project/slime/cvsroot/slime/swank-abcl.lisp	2009/08/18 10:42:07	1.67
+++ /project/slime/cvsroot/slime/swank-abcl.lisp	2009/08/19 14:58:02	1.68
@@ -16,7 +16,12 @@
 
 (defun sys::break (&optional (format-control "BREAK called") 
                    &rest format-arguments)
-  (let ((*saved-backtrace* (backtrace-as-list-ignoring-swank-calls)))
+  (let ((*saved-backtrace* 
+         #+#.(swank-backend::with-symbol 'backtrace 'sys) 
+         (sys:backtrace)
+         #-#.(swank-backend::with-symbol 'backtrace 'sys)
+         (ext:backtrace-as-list)
+         ))
     (with-simple-restart (continue "Return from BREAK.")
       (invoke-debugger
        (sys::%make-condition 'simple-condition
@@ -260,26 +265,45 @@
 
 (defvar *sldb-topframe*)
 
-(defun backtrace-as-list-ignoring-swank-calls ()
-  (let ((list (ext:backtrace-as-list)))
-    (subseq list (1+ (or (position (intern "SWANK-DEBUGGER-HOOK" 'swank) list :key 'car) -1)))))
-
 (defimplementation call-with-debugging-environment (debugger-loop-fn)
-  (let ((*sldb-topframe* (car (backtrace-as-list-ignoring-swank-calls)) #+nil (excl::int-newest-frame)))
+  (let* ((magic-token (intern "SWANK-DEBUGGER-HOOK" 'swank))
+         (*sldb-topframe* 
+          #+#.(swank-backend::with-symbol 'backtrace 'sys)
+          (second (member magic-token (sys:backtrace)
+                          :key #'(lambda (frame) 
+                                   (first (sys:frame-to-list frame)))))
+          #-#.(swank-backend::with-symbol 'backtrace 'sys)
+          (second (member magic-token (ext:backtrace-as-list)
+                          :key #'(lambda (frame) 
+                                   (first frame))))
+          ))
     (funcall debugger-loop-fn)))
 
+(defun backtrace (start end)
+  "A backtrace without initial SWANK frames."
+  (let ((backtrace 
+         #+#.(swank-backend::with-symbol 'backtrace 'sys)
+         (sys:backtrace)
+         #-#.(swank-backend::with-symbol 'backtrace 'sys)
+         (ext:backtrace-as-list)
+         ))
+    (subseq (or (member *sldb-topframe* backtrace) backtrace)
+            start end)))
+
 (defun nth-frame (index)
-  (nth index (backtrace-as-list-ignoring-swank-calls)))
+  (nth index (backtrace 0 nil)))
 
 (defimplementation compute-backtrace (start end)
   (let ((end (or end most-positive-fixnum)))
-    (loop for f in (subseq (backtrace-as-list-ignoring-swank-calls) start end)
-          collect f)))
+    (backtrace start end)))
 
 (defimplementation print-frame (frame stream)
-  (write-string (string-trim '(#\space #\newline)
-                             (prin1-to-string frame))
-                stream))
+  (write-string 
+   #+#.(swank-backend::with-symbol 'backtrace 'sys)
+   (sys:frame-to-string frame)
+   #-#.(swank-backend::with-symbol 'backtrace 'sys)
+   (string-trim '(#\space #\newline) (prin1-to-string frame))
+   stream))
 
 (defimplementation frame-locals (index)
   `(,(list :name "??" :id 0 :value "??")))
--- /project/slime/cvsroot/slime/ChangeLog	2009/08/18 10:42:07	1.1841
+++ /project/slime/cvsroot/slime/ChangeLog	2009/08/19 14:58:02	1.1842
@@ -1,3 +1,9 @@
+2009-08-19  Mark Evenson  <evenson at panix.com>
+
+	* swank-abcl.lisp: Accommodate the new Java/Lisp stack frame
+	abstraction in the upcoming abcl-0.16. (based on code from Tobias
+	Rittweiler).
+	
 2009-08-18  Mark Evenson  <evenson at panix.com>
 
 	Add multithreading code for abcl-0.16. (Tobias Rittweiler)