[slime-cvs] CVS slime

[heller]

Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv7159

Modified Files:
	ChangeLog swank-clisp.lisp 
Log Message:
Fixes for CLISP 2.44.  (Patch by Mark Harig.)

* swank-clisp.lisp (sldb-backtrace, %parse-stack-values):
sys::frame-up-1 no longer exists; use sys::frame-up instead.


--- /project/slime/cvsroot/slime/ChangeLog	2008/02/22 14:10:36	1.1296
+++ /project/slime/cvsroot/slime/ChangeLog	2008/02/22 14:11:52	1.1297
@@ -1,3 +1,10 @@
+2008-02-22  Mark Harig <idirectscm at aim.com>
+
+	Fixes for CLISP 2.44.
+
+	* swank-clisp.lisp (sldb-backtrace, %parse-stack-values):
+	sys::frame-up-1 no longer exists; use sys::frame-up instead.
+
 2008-02-22  Helmut Eller  <heller at common-lisp.net>
 
 	* slime.el (slime-pop-to-location): Slight cleanups.
--- /project/slime/cvsroot/slime/swank-clisp.lisp	2008/02/09 18:47:05	1.67
+++ /project/slime/cvsroot/slime/swank-clisp.lisp	2008/02/22 14:11:52	1.68
@@ -1,4 +1,4 @@
-;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
+;;;; -*- indent-tabs-mode: nil -*-
 
 ;;;; SWANK support for CLISP.
 
@@ -249,6 +249,21 @@
 
 (defvar *sldb-backtrace*)
 
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (when (string< "2.44" (lisp-implementation-version))
+    (pushnew :clisp-2.44+ *features*)))
+
+(defun sldb-backtrace ()
+  "Return a list ((ADDRESS . DESCRIPTION) ...) of frames."
+  (do ((frames '())
+       (last nil frame)
+       (frame (sys::the-frame)
+              #+clisp-2.44+ (sys::frame-up 1 frame 1)
+              #-clisp-2.44+ (sys::frame-up-1 frame 1))) ; 1 = "all frames"
+      ((eq frame last) (nreverse frames))
+    (unless (boring-frame-p frame)
+      (push frame frames))))
+
 (defimplementation call-with-debugging-environment (debugger-loop-fn)
   (let* (;;(sys::*break-count* (1+ sys::*break-count*))
          ;;(sys::*driver* debugger-loop-fn)
@@ -260,15 +275,6 @@
 (defun nth-frame (index)
   (nth index *sldb-backtrace*))
 
-(defun sldb-backtrace ()
-  "Return a list ((ADDRESS . DESCRIPTION) ...) of frames."
-  (do ((frames '())
-       (last nil frame)
-       (frame (sys::the-frame) (sys::frame-up-1 frame 1))) ; 1 = "all frames"
-      ((eq frame last) (nreverse frames))
-    (unless (boring-frame-p frame)
-      (push frame frames))))
-
 (defun boring-frame-p (frame)
   (member (frame-type frame) '(stack-value bind-var bind-env)))
 
@@ -276,6 +282,8 @@
   (with-output-to-string (s)
     (sys::describe-frame s frame)))
 
+;; FIXME: they changed the layout in 2.44 so the frame-to-string &
+;; string-matching silliness no longer works.
 (defun frame-type (frame)
   ;; FIXME: should bind *print-length* etc. to small values.
   (frame-string-type (frame-to-string frame)))
@@ -418,7 +426,9 @@
         (venv-ref (next-venv env) (- i (/ (1- (length env)) 2))))))
 
 (defun %parse-stack-values (frame)
-  (labels ((next (fp) (sys::frame-down-1 fp 1))
+  (labels ((next (fp)
+             #+clisp-2.44+ (sys::frame-down 1 fp 1)
+             #-clisp-2.44+ (sys::frame-down-1 fp 1))
            (parse (fp accu)
              (let ((str (frame-to-string fp)))
                (cond ((is-prefix-p "- " str)
@@ -433,6 +443,8 @@
                      (t (parse (next fp) accu))))))
     (parse (next frame) '())))
 
+(setq *features* (remove :clisp-2.44+ *features*))
+
 (defun is-prefix-p (pattern string)
   (not (mismatch pattern string :end2 (min (length pattern)
                                            (length string)))))